Extract all .gz file in folder using VBA Shell command - shell

I have the following VBA code to extract all the files within a given directory.
Sub extractAllFiles()
Dim MyObj As Object, MySource As Object, file As Variant
Dim shellStr As String
file = Dir("C:\Downloads\")
While (file <> "")
If InStr(file, ".gz") > 0 Then
shellStr = "winzip32 -e C:\Downloads\" & file & " C:\Downloads\"
Call Shell(shellStr, vbHide)
End If
file = Dir
Wend
End Sub
When I execute this sub routine I get a Run-Time error 53, "File Not Found" error. When I copy the shellStr... Example: winzip32 -e C:\Downloads\file1.gz C:\Downloads\ and execute it from command prompt, it works perfectly! I get the text file within file1.gz extracted to the downloads directory. However running it from VBA doesn't seem to work.
Can anyone shed some light?

You should try with the full path of the shell command, like this, that worked for me:
Sub extractAllFiles()
Dim MyObj As Object, MySource As Object, file As Variant
Dim shellStr As String
file = Dir("C:\Downloads\")
While (file <> "")
If InStr(1, file, ".gz") > 0 Then
shellStr = "C:\Program Files (x86)\WinZip\winzip32 -e C:\Downloads\" & file & " C:\Downloads\"
Call Shell(shellStr, vbHide)
End If
file = Dir
Wend
End Sub
My winzip is installed as C:\Program Files (x86)\WinZip\winzip32. You should use yours.
Your install path may be:
C:\Program Files\WinZip\winzip32

WinZip path needs to be absolute path:
C:\Program Files\WinZip\winzip32'

Check your WinZip path. That needs to be fine fixed to the full path to your WinZip.

Using the logic from this SO post, try the below code:
Sub ExtractAllFiles()
Dim FileName As String
Dim ShellStr
FileName = Dir("C:\Downloads\*.gz")
Do While Len(FileName) > 0
ShellStr = "winzip32 -e " & FileName & " C:\Downloads"
Call Shell(ShellStr, vbHide)
FileName = Dir
Loop
End Sub
Let us know if this helps.

Related

How can I extract the running scripts name using PCOMM VBScript

First time posting so please forgive me if I miss something.
I'm trying to output the name of the running script (along with other variables) to a plain text file. I've been able to get everything else I need except for the Script Name. I've tried using WScript & Echo commands but they do not appear to function in my environment. These are PCOMM .mac files.
Thanks in advance
Here are some of things I've tried so far:
FilePath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")`
<<< The above works for Filepath but does not include the macro name
FileName = CreateObject("Scripting.FileSystemObject").GetFileName(".")
<<< The above just outputs the "."
Dim scriptName : scriptName = WScript.ScriptName
<<< The above gives error message: Variable is undefined: 'WScript'
Dim scriptName : WScript.Echo WScript.ScriptName
<<< The above gives error message: Variable is undefined: 'WScript'
Function GetName()
Dim WshShell, objEnv
Set WshShell = CreateObject("WScript.Shell")
Set objEnv = WshShell.Environment("Process")
GetName = objEnv("SCRIPTNAME")
End Function
<<< The above doesn't output anything. I used similar logic to successfully extract the HOMEPATH.
I managed to figure this one out after all:
REM Initialize the session
sHandle = autECLConnMgr.autECLConnList(1).Handle
REM Connect to the current session
sHandle = autECLSession.Handle
msgbox("Variable Check: " & ThisMacroName), vbOKOnly, "Validation check"

How can I redirect my vbscript output to a file using batch file?

I am new to Windows Scripting. I have a simple script for archiving using WinRAR CLI utility. I have to schedule this script using batch file. During archiving there are some errors and I want them to write in a simple text file or at least I can write entire output of archiving in a file. How can I change my code to do this?
Dim MyDate
Dim OutputFile
const WaitUntilFinished = true, DontWaitUntilFinished = false, ShowWindow = 1, DontShowWindow = 0
MyDate = Replace(Date, "/", "-")
OutputFile = "backup-" & mydate & ".rar"
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.CurrentDirectory = "C:\Users\ABC\Desktop\"
objShell.Run "C:\windows\Rar.exe a .\VBScripts\backups\" & OutputFile & " software", ShowWindow, WaitUntilFinished
objShell.Popup "Archiving Completed Successfully!",5, "Scheduled Backup"
Set objShell = Nothing
Batch file is like this;
#echo off
start /wait C:\Users\ABC\Desktop\VBScripts\scheduled_backup.vbs
Change your command line to include redirection to a log file:
logfile = "C:\path\to\your.log"
objShell.Run "%COMSPEC% /c C:\windows\Rar.exe a .\VBScripts\backups\" & _
OutputFile & " software >""" & logfile & """", ShowWindow, WaitUntilFinished
Use this function instead of WScript.Shell.Run:
' Runs an external program and pipes it's output to
' the StdOut and StdErr streams of the current script.
' Returns the exit code of the external program.
Function Run (ByVal cmd)
Dim sh: Set sh = CreateObject("WScript.Shell")
Dim wsx: Set wsx = Sh.Exec(cmd)
If wsx.ProcessID = 0 And wsx.Status = 1 Then
' (The Win98 version of VBScript does not detect WshShell.Exec errors)
Err.Raise vbObjectError,,"WshShell.Exec failed."
End If
Do
Dim Status: Status = wsx.Status
WScript.StdOut.Write wsx.StdOut.ReadAll()
WScript.StdErr.Write wsx.StdErr.ReadAll()
If Status <> 0 Then Exit Do
WScript.Sleep 10
Loop
Run = wsx.ExitCode
End Function
Call script instead of start in your batch and use redirection:
script //nologo C:\Users\ABC\Desktop\VBScripts\scheduled_backup.vbs 2> errors.txt

Code must be in VBSCRIPT or Shell Script

Hi I need to read from a text file and copy files whose name are present in that file. location of the files are different and i need to copy it from one location to another
Const DestinationFile = "C:\Users\$svijay8\Desktop\libnew\"
Const SourceFile = "C:\Users\$svijay8\Desktop\lib\*"
Dim fso
Dim fName
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(DestinationFile) Then
WScript.Echo "Folder is there"
Else
Set fso = CreateObject("Scripting.FileSystemObject")
Set listFile = fso.OpenTextFile("inputold.txt")
do while not listFile.AtEndOfStream
fName = listFile.ReadLine()
Set fName = fso.GetFile(C:\Users\$svijay8\Desktop\lib\*so)
If fname.FileExists("C:\Users\$svijay8\Desktop\lib\*") Then
WScript.Echo "Reached If loop in do while in If condition above copy"
fso.CopyFile SourceFile, "C:\Users\$svijay8\Desktop\libnew\", True
Else
End If
loop
End If
Not sure what you mean by "Code must be in VBScript or ??shell??". Do you mean Powershell? or MS-DOS BATCH commands for CMD.EXE? Or have you installed a proper Unix-like shell (e.g. bash) on your Windows box?
Anyway, you should be able to do it like this - if you call this "shell".
For /f %%f in (inputold.txt) do copy /y c:\source\%%f c:\dest

Trouble compressing large files using vbs

I have jumbled up a vbs script to compress files older than 7 days using 7za's command line utility. While most of the logic works fine, I am able to compress single file into single zip file.
The problem arises when I try to add all matching files to one zip file. Below is the code snippet:
strCommand = "7za.exe -mx=9 a " & ObjectFolder & sysDate & ".zip " & strFileName
strRun = objShell.Run(strCommand, 0, True)
Now as per the 2nd line, setting True would make sure the script will wait till command is finished executing. But the problem is 7za is exiting immediately and going to the next loop, processing the next file and since it tries to create same zip file, I get access denied error.
Can someone please help me to fix this?
I have also tested the scenario in command prompt. What I did was, execute below 2 commands simultaneously in separate prompts:
Prompt 1:
C:\7za.exe -mx=9 a test.zip c:\sample1.pdf
Prompt 2:
C:\7za.exe -mx=9 a test.zip c:\sample2.pdf
Prompt 2 resulted in following error:
Error: test.zip is not supported archive
System error:
The process cannot access the file because it is being used by another process.
This is the same error I am getting in my script and I need help in resolving this. Any pointers will be helpful!
UPDATE:
With the great pointers provided by both John and Ansgar, I was able to resolve this! It turned out to be a bug in my script! In my script, I included a check to see if the file is in use by any other process before processing it for archive. So I was checking this by opening the file for appending using:
Set f = objFSO.OpenTextFile(strFile, ForAppending, True)
But before proceeding to process the same file, I was not CLOSING it in the script, hence the error: The process cannot access the file because it is being used by another process
After I closed the file, all went well!
Thanks Again for all the great support I got here!
As a token of gratitude, I am sharing the whole script for anyone's use. Please note that I am not the original author of this, I gathered it from various sources and tweaked it a little bit to suit my needs.
Archive.vbs
Const ForAppending = 8 ' Constant for file lock check
Dim objFSO, objFolder, objFiles, objShell
Dim file, fileExt, fileName, strCommand, strRun, strFile
Dim SFolder, OFolder, Extension, DaysOld, sDate
'''' SET THESE VARIABLES! ''''
SFolder = "C:\SourceFolder\" 'Folder to look in
OFolder = "C:\OutputFolder\" 'Folder to put archives in
Extension = "pdf" 'Extension of files you want to zip
DaysOld = 1 'Zip files older than this many days
''''''''''''''''''''''''''''''
sDate = DatePart("yyyy",Date) & "-" & Right("0" & DatePart("m",Date), 2) & "-" & Right("0" & DatePart("d",Date), 2)
'Create object for playing with files
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Create shell object for running commands
Set objShell = wscript.createObject("wscript.shell")
'Set folder to look in
Set objFolder = objFSO.GetFolder(SFolder)
'Get files in folder
Set objFiles = objFolder.Files
'Loop through the files
For Each file in objFiles
fileName = Split(file.Name, ".")
fileExt = fileName(UBound(fileName))
'See if it is the type of file we are looking for
If fileExt = Extension Then
'See if the file is older than the days chosen above
If DateDiff("d", file.DateLastModified, Now()) >= DaysOld Then
strFile = file.Path
'See if the file is available or in use
Set f = objFSO.OpenTextFile(strFile, ForAppending, True)
If Err.Number = 70 Then ' i.e. if file is locked
Else
f.close
strFName = objFSO.GetBaseName(file.name)
strCommand = "C:\7za.exe -mx=9 a " & OFolder & sDate & ".zip " & strFile
strRun = objShell.Run(strCommand, 0, True)
'wscript.echo strCommand ' un-comment this to check the file(s) being processed
'file.Delete ' un-comment this to delete the files after compressing.
End If
End If
End If
Next
'Cleanup
Set objFiles = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
Set objShell = Nothing
wscript.Quit
===========================
Thanks
-Noman A.
Not quite what you asked for, but here's a batch script I use for a similar task in case that helps get you past of your immediate issue:
ArchiveScriptLog.Bat
::ensure we're in the right directory, then run the script & log the output
cls
pushd "c:\backup scripts"
ArchiveScript.bat > ArchiveScript.log
popd
ArchiveScript.bat
::Paths (must include the \ on the end). There must be no space between the equals and the value
::UNC paths are acceptable
Set FolderToBackup=F:\EnterpriseArchitect\Energy\
Set BackupPath=F:\EnterpriseArchitect\!ARCHIVE\
Set RemoteBackupPath=\\ukccojdep01wok\h$\Energy\cciobis01edc\
Set SevenZip=C:\Program Files (x86)\7-Zip\
::Get DATE in yyyymmdd format; done in two lines to make it easy to change the date format
FOR /F "TOKENS=2,3,4 DELIMS=/ " %%A IN ('echo %Date%') DO (SET mm=%%A&SET dd=%%B&SET yyyy=%%C)
SET strDate=%yyyy%%mm%%dd%
::Set the Backup File to be the backup path with the current date & .zip on the end
Set BackupFile=%BackupPath%%strDate%.zip
::create a zip containing the contents of folderToBackup
pushd %SevenZip%
7z a "%BackupFile%" "%FolderToBackup%"
popd
::go to the archive directory & copy all files in there to the remote location (this accounts for previous errors if the network were unavailable)
pushd "%BackupPath%"
move *.zip "%RemoteBackupPath%"
popd
::delete off backups in the remote location which are older than 90 days
pushd "%RemoteBackupPath%"
forfiles /D -90 /M *.zip /C "cmd /c del #file"
popd
Your command shouldn't return before 7za has finished its task (and it doesn't in my tests). Try changing your code to the following, so you can see what's going on:
strCommand = "7za.exe -mx=9 a " & ObjectFolder & sysDate & ".zip " & strFileName
strCommand = "%COMSPEC% /k " & strCommand
strRun = objShell.Run(strCommand, 1, True)
It may also be a good idea to quote the filenames:
Function qq(str)
qq = Chr(34) & str & Chr(34)
End Function
strCommand = "7za.exe -mx=9 a " & qq(ObjectFolder & sysDate & ".zip") & " " _
& qq(strFileName)

How do loop through and open *.frm files in VB6?

In VB6, how can I loop through all the .frm files in a folder and do something to each of them?
MyFile = Dir(CurDir() & "\" & "*.frm")
Do While MyFile <> ""
' do stuff to file
MyFile = Dir
Loop

Resources