This question already has an answer here:
unzip file silently vbscript
(1 answer)
Closed 7 months ago.
Below is my script
zIP Script
wvar1 = WScript.CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\Dumps"
wvar2 = WScript.CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\Dumps.zip"
set wshell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
ArchiveFolder wvar2, wvar1
Sub ArchiveFolder (zipFile, sFolder)
With CreateObject("Scripting.FileSystemObject")
zipFile = .GetAbsolutePathName(zipFile)
sFolder = .GetAbsolutePathName(sFolder)
With .CreateTextFile(zipFile, True)
.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, chr(0))
End With
End With
With CreateObject("Shell.Application")
.NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items
Do Until .NameSpace(zipFile).Items.Count = _
.NameSpace(sFolder).Items.Count
WScript.Sleep 1000
Loop
End With
End Sub
unzIP Script
Set objFile = objFSO.GetFile(strPath)
strFolder = objFSO.GetParentFolderName(objFile)
ZipFile = "" & strFolder & "\Scripts\Dumper_AV.zip" & ""
ExtractTo= var1
Set fso = CreateObject("Scripting.FileSystemObject")
sourceFile = fso.GetAbsolutePathName(ZipFile)
destFolder = fso.GetAbsolutePathName(ExtractTo)
Set objShell = CreateObject("Shell.Application")
Set FilesInZip=objShell.NameSpace(sourceFile).Items()
objShell.NameSpace(destFolder).copyHere FilesInZip, 16
Set fso = Nothing
Set objShell = Nothing
Set FilesInZip = Nothing
But i wanted it hidden to zip silently, but it opens up a progress box displaying compressing same with my unzip script.
is there a way to hide it.
As per docs vOptions 4 to hide progress is being ignored
Solved Hidden Unzipping But solution required for hidden Zipping
Partial Solution
For UNZIP Script Only
Trick 1 : Use Vbsedit to compile vbscript to exe and it will execute silently
Trick 2 : .NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items, &H4
Note: As per docs .NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items, 4 doesn't work. vOption variable 4 need to be converrted to Hex string &H4 to make it work
Note the second parameter to CopyHere.
.NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items, 4
From the docs
Folder.CopyHere(
vItem,
[ vOptions ]
)
...
(4)
Do not display a progress dialog box.
https://learn.microsoft.com/en-us/windows/win32/shell/folder-copyhere
Related
I'm looking at having a script that decompresses a file (PDMsetup.zip) and then launch the executable that it extracts.
ZipFile="PDMsetup.zip"
ExtractTo=".\"
Set fso = CreateObject("Scripting.FileSystemObject")
sourceFile = fso.GetAbsolutePathName(ZipFile)
destFolder = fso.GetAbsolutePathName(ExtractTo)
Set objShell = CreateObject("Shell.Application")
Set FilesInZip=objShell.NameSpace(sourceFile).Items()
objShell.NameSpace(destFolder).copyHere FilesInZip, 16
Set fso = Nothing
Set objShell = Nothing
Set FilesInZip = Nothing
wscript.sleep 480000
Set objShell = CreateObject("Wscript.Shell")
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strPath)
strFolder = objFSO.GetParentFolderName(objFile)
strPath = strFolder & "\Startwinstall.exe"
objShell.Run strPath
I want to get rid of;
wscript.sleep 480000
and replace it with a command that tells the script wait until the extraction is done before launching startwinstall.exe
I've kept adjusting the wait time to make up for differences in PC performance with the extraction, but a command to just 'wait' until it's done would be preferential.
Delete any previous copy of the installer exe in the target folder and then wait for that file to be created. Create your objects once at the top of the script. And there's no need to set the objects to Nothing. That will happen automatically when the script ends. The edited script is below:
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oWSH = CreateObject("Wscript.Shell")
Set oApp = CreateObject("Shell.Application")
MyFolder = oFSO.GetParentFolderName(WScript.ScriptFullName)
ExtractTo = ".\"
ZipFile = "PDMsetup.zip"
StartApp = ExtractTo & "Startwinstall.exe"
On Error Resume Next
oFSO.DeleteFile StartApp
On Error Goto 0
sourceFile = oFSO.GetAbsolutePathName(ZipFile)
destFolder = oFSO.GetAbsolutePathName(ExtractTo)
Set FilesInZip = oApp.NameSpace(sourceFile).Items()
oApp.NameSpace(destFolder).copyHere FilesInZip, 16
Do Until oFSO.FileExists(StartApp)
WScript.Sleep 1000
Loop
oWSH.Run StartApp
Note: I assigned a MyFolder variable, but it's not currently being used. ExtractTo = ".\" could be changed to ExtractTo = MyFolder. You could also eliminate the GetAbsolutePathName lines if you are using MyFolder with the ZipFile name. There are always many ways to do the same thing.
Note: I think the above can be done with a much briefer (probably two line) PowerShell script. Let me know if you're interested in that solution.
In continuation of Call VBScript from Windows Explorer Context Menu, I managed to get a VBScript file running from SendTo in the Windows Explorer.
I've changed my code to copy the file that invokes the script to my Temp folder. The new problem is that if the path is over 256 characters, I can't loop through WScript.Arguments to get all of it. Is there another way to get the full path (including the file name and it's extension)?
Option Explicit
Call OpenDocuWorksFile
Sub OpenDocuWorksFile()
Const sTitle = "Open DocuWorks File"
Dim iArgumentsCount
Dim iArgument
Dim sFilePath
Dim sTempFolder
Dim oFileScriptingObject
Dim sFileName
Dim oShell
iArgumentsCount = WScript.Arguments.Count
On Error Resume Next
For iArgument = 0 To iArgumentsCount
sFilePath = sFilePath & WScript.Arguments(iArgument)
Next
On Error GoTo 0
Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
With oFileScriptingObject
sFileName = .GetFileName(sFilePath)
sTempFolder = oFileScriptingObject.GetSpecialFolder(2) 'Temp Folder
If .GetExtensionName(sFileName) = "xdw" Then
.CopyFile sFilePath, sTempFolder & "\", True 'Overwrite
Set oShell = CreateObject("Shell.Application")
oShell.Open sTempFolder & "\" & sFileName
Else
MsgBox "Please select a DocuWorks file.（.xdw)", vbCritical, sTitle
End If
End With
Set oFileScriptingObject = Nothing
Set oShell = Nothing
End Sub
This question already has answers here:
Copy a file from one folder to another using vbscripting
(5 answers)
Closed 2 years ago.
I want to make an automatic backup of my excel files using vbscript.
It works to copy the entire folder but I want to copy only the xlsx files.
Here is the code until now:
Dim objFSO, objFolder, evrFiles
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set evrFiles = objFolder.Files
For Each evrFile in evrFiles
If InStr(1, evrFile.Name, ".xlsx", vbBinaryCompare) > 0 Then
objFSO.CopyFile "C:\Users\Home\Desktop\vbs\" & evrFile.Name, "E:\test2"
End If
Next
WScript.Quit
It throws error on line 5 char 1 "Object required: " "
Any ideas?
LE: I have also tried:
Dim objFSO, objFolder
Set wshNetwork = CreateObject("WScript.Network")
strUser = wshNetwork.Username
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\" & strUser & "\Desktop\vbs")
Set evrFiles = objFolder.Files
For Each evrFile in evrFiles
If InStr(1, evrFile.Name, ".xlsx", vbBinaryCompare) > 0 Then
objFSO.CopyFile "C:\Users\" & strUser & "\Desktop\vbs\" & evrFile.Name, "E:\test2"
End If
Next
WScript.Quit
But this one gives me "Permission denied on line 9 char 3"
This one works(to copy the entire folder) but I want only the excel files.
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshNetwork = CreateObject("WScript.Network")
strUser = wshNetwork.Username
objFSO.CopyFolder"C:\Users\" & strUser & "\Desktop\vbs","E:\test2"
You dont need to iterrate each file, you could do something like:
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshNetwork = CreateObject("WScript.Network")
strUser = wshNetwork.Username
objFSO.CopyFile "C:\Users\" & strUser & "\Desktop\vbs\*.xlsx", "E:\test2\"
You may also want to set the overwrite flag when doing the copy, it there will be existing files already in the destination folder.
objFSO.CopyFile "C:\Users\" & strUser & "\Desktop\vbs\*.xlsx","E:\test2", True
I'm trying to create a zip file, then copy three folders into it. I get the error on line 33 char 1, error state object required, I have searched and googled but just can't seem to either understand what I'm reading or understand what I really need to search for. Anyhow, here is my code.
Option Explicit
Dim objFSO, objFolder1, objFolder2, objFolder3, FolderToZip, ziptoFile, FolderGroup
Dim ShellApp, eFile, oNewZip, strZipHeader
Dim ZipName, Folder, i, Zip, Item
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder1 = objFSO.GetFolder("C:\Windows\Temp\SMSTSLog")
Set objFolder2 = objFSO.GetFolder ("C:\Windows\System32\CCM\Logs")
Set objFolder3 = objFSO.GetFolder ("C:\Windows\SysWOW64\CCM\Logs")
'For Each efile In objFolder.Files
' If DateDiff("d",eFile.DateLastModified,Now) >= 2 Then
' objFSO.MoveFile eFile, "C:\Documents and Settings\User\Desktop\Test2\"
' End If
'Next
Wscript.Sleep 2000
Set oNewZip = objFSO.OpenTextFile("C:\win7tools\testing script.zip", 8, True)
strZipHeader = "PK" & Chr(5) & Chr(6)
For i = 0 To 17
strZipHeader = strZipHeader & Chr(0)
Next
oNewZip.Write strZipHeader
oNewZip.Close
Set oNewZip = Nothing
WScript.Sleep 5000
FolderGroup = Array(objFolder1,objFolder2,objFolder3)
FolderToZip = "FolderGroup"
ZipToFile = "C:\Win7tools\Test Script.zip"
Set ShellApp = CreateObject("Shell.Application")
Set Zip = ShellApp.NameSpace(ZipToFile)
'Set Folder = ShellApp.NameSpace(FolderToZip)
ShellApp.NameSpace(FolderGroup).CopyHere Zip.NameSpace(ZipToFile)
WScript.Sleep 10000
set ShellApp = Nothing
set FolderToZip = Nothing
set ZipToFile = Nothing
When in doubt, read the documentation:
retVal = Shell.NameSpace(
vDir
)
Parameters
vDir [in]
Type: Variant
The folder for which to create the Folder object. This can be a string that specifies the path of the folder or one of the ShellSpecialFolderConstants values. Note that the constant names found in ShellSpecialFolderConstants are available in Visual Basic, but not in VBScript or JScript. In those cases, the numeric values must be used in their place.
The NameSpace method expects either a string with a path or the integer value of one of the ShellSpecialFolderConstants, not an array of Folder objects. Also you got the order wrong. The object on which you call the copyHere method is the zip file. The argument is what you want to copy to the zip file (a path string should do just fine here). Plus, the name of the zip file you create is different from the name of the zip file you try to add the folders to.
Change your code to this:
folder1 = "C:\Windows\Temp\SMSTSLog"
folder2 = "C:\Windows\System32\CCM\Logs"
folder3 = "C:\Windows\SysWOW64\CCM\Logs"
zipfile = "C:\Win7tools\Test Script.zip"
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.OpenTextFile(zipfile, 2, True).Write "PK" & Chr(5) & Chr(6) _
& String(18, Chr(0))
Set ShellApp = CreateObject("Shell.Application")
Set zip = ShellApp.NameSpace(zipfile)
zip.CopyHere folder1
zip.CopyHere folder2
zip.CopyHere folder3
WScript.Sleep 10000
WinZip has a Command Line Interface. You might have to download and install it depending on your version: http://www.winzip.com/prodpagecl.htm
The below is a test script that works for WinZip version 9.0 if it helps.
Const WinZip = "C:\Program Files\WinZip9.0\wzzip.exe" 'WinZip Version 9.0
BasePath = "C:\Path\To\Folders\"
strZipFilePath = BasePath & "Test.zip"
strArchiveMe = BasePath & "Folder_A"
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(WinZip) Then
MsgBox "WinZip (wzzip.exe) Does Not Exist"
WScript.Quit
End If
'''// For Below Command - Change "-a" TO "-mu" To Auto Delete The file After Zip Is Created
'''// For Below Command - Change "-yb" TO "-ybc" To Answer YES To all Promps and not Terminate Operation
strcommand = Chr(34) & WinZip & Chr(34) & " -a -yb " & Chr(34) & strZipFilePath & Chr(34) & " " & Chr(34) & strArchiveMe & Chr(34)
objShell.Run strcommand, 1, True
The command format is:
winzip [action] [options] [Zip Path] [Path to file/folder to zip]
I want to add a file to a folder and save it as a compressed folder in VBScript.
I've written the following code, but it only creates the ZIP file and doesn't add the files to it. What can be the problem with this code?
Option Explicit
dim wshShell
Const MoveMode = True
Const BackupDir = "D:\csv\Image\"
Const Outfilename = "MyZip.zip"
Const TimeoutMins = 10 ' Timeout for individual file compression operation
'Set wshShell = CreateObject("WScript.shell")
Dim FSO : set FSO = CreateObject("Scripting.FileSystemObject")
Dim Folder : Set Folder = FSO.GetFolder("D:\csv\Image")
Dim Files : Set Files = Folder.Files
Dim File
Dim Counter : Counter=0
Dim Timeout : Timeout = 0
FSO.CreateTextFile "D:\csv\" & OutFilename,true '.WriteLine "PK" & Chr(5) & Chr(6) & String(18, 0)
Dim Shell : Set Shell = CreateObject("Shell.Application")
Dim ZipFile: Set ZipFile = Shell.NameSpace("D:\csv\"& OutFilename)
If Not ZipFile Is Nothing Then
Shell.NameSpace("D:\csv\"&Outfilename).CopyHere "D:\csv\Image\calender.png"
End If
This shows waiting 500 ms after creating a new ZIP file before attempting to copy data into it. Have you tried using WScript.Sleep(500)?
Dim FSO : set FSO = CreateObject("Scripting.FileSystemObject")
Dim Shell : Set Shell = CreateObject("Shell.Application")
If Not FSO.FileExists("D:\csv\" & OutFilename) Then
NewZip("D:\csv\" & OutFilename)
End If
If Not ZipFile Is Nothing Then
Shell.NameSpace("D:\csv\" & Outfilename).CopyHere BackupDir & "calender.png"
End If
Sub NewZip(sNewZip)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
Set oNewZipFSO = CreateObject("Scripting.FileSystemObject")
Set oNewZipFile = oNewZipFSO.CreateTextFile(sNewZip)
oNewZipFile.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
oNewZipFile.Close
Set oNewZipFSO = Nothing
Wscript.Sleep(500)
End Sub
(Untested)