I am trying to ZIP up a folder in VBScript and it doesn't seem to work. I'm certain I am creating the header file correctly.
It creates the actual file correctly, just doesn't zip the folder.
Anyone got any ideas:
Sub ArchiveFolder (folder)
Dim fso, wShell, sApp, zipFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set wShell = CreateObject("WScript.Shell")
Set sApp = CreateObject("Shell.Application")
Set zipFile = fso.CreateTextFile(folder & ".zip")
' Write zip file header.
zipFile.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
zipFile.Close
sApp.NameSpace(folder & ".zip").CopyHere folder
End Sub
The answer I found here. The magic is in the last Do..Loop where the script wait the Shell to do it job.
ArchiveFolder "sub\foo.zip", "..\baz"
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
Check your argument. folder must be the path to the object you want to put into the zip file. If it's a folder object you have to use folder.Path, because the default method of folder objects is Name, and CopyHere can't find the object with just the name.
You could add some debugging statements to your function to check that:
WScript.Echo TypeName(folder)
If fso.FolderExists(folder) Then
WScript.Echo folder & " exists."
Else
WScript.Echo folder & " doesn't exist."
End If
you could call an external zip file via %comspec%
oShell.Run "%comspec% /c c:\windows\7za.exe a " & oFile &".zip " & oFile & " -tzip",,True
Source http://www.scriptlook.com/zip-large-files-in-a-directory-2/
Related
I'm a linux guy and new to windows, im trying to create a small vbs script to create bunch of folders.
Im trying to create a mainfolder according to user input and 4 subfolder in it with static names. I somehow got two seperate working scripts for mainfolder and subfolder but I would like to combine them both which means once the mainfolder is created as per user input next it should create subfolders below that.
Script which creates Mainfolder.vbs as per user input:
strfolder = InputBox("Please enter a name for your new folder:")
set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CreateFolder "C:\test\" & strfolder
Script which creates subfolders.vbs folders:
Option Explicit
dim wshShell
set wshShell = wscript.CreateObject("WScript.Shell")
DIM fSO
DIM foldername1
DIM foldername2
DIM foldername3
DIM foldername4
foldername1=("subfolder1")
foldername2=("subfolder2")
foldername3=("subfolder3")
foldername4=("subfolder4")
dim folderpath
SET FSO=CreateObject("Scripting.FileSystemObject")
folderpath = "C:\test" & _
"\" & foldername1
wscript.echo "Creating folder: " & folderpath
FSO.CREATEFOLDER(folderpath)
folderpath = "C:\test" & _
"\" & foldername2
wscript.echo "Creating folder: " & folderpath
FSO.CREATEFOLDER(folderpath)
folderpath = "C:\test" & _
"\" & foldername3
wscript.echo "Creating folder: " & folderpath
FSO.CREATEFOLDER(folderpath)
folderpath = "C:\test" & _
"\" & foldername4
wscript.echo "Creating folder: " & folderpath
FSO.CREATEFOLDER(folderpath)
In short, how can I create a mainfolder as per user input and subfolders with static names?
would like to combine these both and work together as a single script.
You can try with this subroutine : SmartCreateFolder(strFolder)
Sub SmartCreateFolder(strFolder)
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(strFolder) then
SmartCreateFolder(.getparentfoldername(strFolder))
.CreateFolder(strFolder)
End If
End With
End Sub
The combined whole script can be written like that :
Option Explicit
Const Title = "SmartCreateFolder"
Const Time2Wait = 2
Dim ws,MainFolderPath,MainFolderName,SubFolderPath,Arr_SubFolder_Name,i
Set ws = CreateObject("wscript.shell")
Arr_SubFolder_Name = Array("subfolder1","subfolder2","subfolder3","subfolder4")
MainfolderName = InputBox(_
"Please enter a name for your new folder :",Title,"Type the name here")
If MainfolderName = "" Then Wscript.Quit(1)
MainFolderPath = "C:\test\" & MainfolderName
For i=LBound(Arr_SubFolder_Name) To UBound(Arr_SubFolder_Name)
Call SmartCreateFolder(MainFolderPath)
SubFolderPath = MainFolderPath & "\" & Arr_SubFolder_Name(i)
Call SmartCreateFolder(SubFolderPath)
Next
ws.run "Explorer " & MainFolderPath
'---------------------------------------------------------------
Sub SmartCreateFolder(strFolder)
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(strFolder) then
ws.Popup "Creating folder: " & StrFolder,Time2Wait,_
Title,vbInformation+vbSystemModal
SmartCreateFolder(.getparentfoldername(strFolder))
.CreateFolder(strFolder)
End If
End With
End Sub
'---------------------------------------------------------------
I want to create a vbscript that uses robocopy, which is fine, but I was hoping you can provide me the most elegant way to do this...
Copy all contents (Files and folders) of User Directory to this location EXCEPT copy AppData directory (Files and folders) to a different location AND copy Desktop directory to a different location
If FSO.folderExists(SOURCE & strAccount & "\AppData") Then
oShell.Run "robocopy " & appDataSource & " " & appDatastrDestination & appDatastrSwitches
Else
oShell.Run "robocopy " & strSource & " " & strDestination & strSwitches
End If
If you want to use all VBScript, you should be able to work with this. Edit - Added subs to reduce code.
On Error Resume Next
strSourceProfile = "C:\Users\NewUser"
strBaseFolder1 = "C:\Temp\"
strBaseFolder2 = "C:\Temp\Backup\"
strDestFolder1 = "C:\Temp\Backup\Profile\"
strDestFolder2 = "C:\Temp\Backup\Desk\"
strDestFolder3 = "C:\Temp\Backup\App\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OverWriteFiles = True
' make sure target folders exist
ChkFolder strBaseFolder1
ChkFolder strBaseFolder2
ChkFolder strDestFolder1
ChkFolder strDestFolder2
ChkFolder strDestFolder3
For Each objFolder In objFSO.GetFolder(strSourceProfile).SubFolders
If objFolder.Name <> "Desktop" And objFolder.Name <> "AppData" Then
CopyToTarg objFolder.Path, strDestFolder1
End If
Next
For Each objFolder In objFSO.GetFolder(strSourceProfile).SubFolders
If objFolder.Name = "Desktop" Then
CopyToTarg objFolder.Path, strDestFolder2
End If
Next
For Each objFolder In objFSO.GetFolder(strSourceProfile).SubFolders
If objFolder.Name = "AppData" Then
CopyToTarg objFolder.Path, strDestFolder3
End If
Next
Sub ChkFolder(strFolder)
If Not(objFSO.FolderExists(strFolder)) Then
objFSO.CreateFolder(strFolder)
End If
End Sub
Sub CopyToTarg(strSource , strTarget)
objFSO.CopyFolder strSource , strTarget , OverWriteFiles
End Sub
I found (apparently working for everybody) script which only needs to be modified (paths):
Sub NewZip(pathToZipFile)
'WScript.Echo "Newing up a zip file (" & pathToZipFile & ") "
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim file
Set file = fso.CreateTextFile(pathToZipFile)
file.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
file.Close
Set fso = Nothing
Set file = Nothing
WScript.Sleep 500
End Sub
Sub CreateZip(pathToZipFile, dirToZip)
'WScript.Echo "Creating zip (" & pathToZipFile & ") from (" & dirToZip & ")"
Dim fso
Set fso= Wscript.CreateObject("Scripting.FileSystemObject")
pathToZipFile = fso.GetAbsolutePathName(pathToZipFile)
dirToZip = fso.GetAbsolutePathName(dirToZip)
If fso.FileExists(pathToZipFile) Then
'WScript.Echo "That zip file already exists - deleting it."
fso.DeleteFile pathToZipFile
End If
If Not fso.FolderExists(dirToZip) Then
'WScript.Echo "The directory to zip does not exist."
Exit Sub
End If
NewZip pathToZipFile
dim sa
set sa = CreateObject("Shell.Application")
Dim zip
Set zip = sa.NameSpace(pathToZipFile)
'WScript.Echo "opening dir (" & dirToZip & ")"
Dim d
Set d = sa.NameSpace(dirToZip)
' Look at http://msdn.microsoft.com/en-us/library/bb787866(VS.85).aspx
' for more information about the CopyHere function.
zip.CopyHere d.items, 4
Do Until d.Items.Count <= zip.Items.Count
Wscript.Sleep(200)
Loop
End Sub
Can anybody give example how this script should look like with
real paths? I'm trying but it's not working for me.
This script consists solely of two subroutines and thus will never execute anything.
Add the following line to the bottom of the file and it should work (given that the code in the subs is sound, I have not tested):
CreateZip "c:\output\test.zip" "c:\input\"
This will do the following, in order:
Check to see if the output file exists. If it does, it will delete it.
Check to see if the input folder exists, if it does not, the script will exit.
Call the NewZip sub which just creates an "empty" .zip file.
Copy files to the zip file.
Pause for a while, probably to ensure you don't try to access the ZIP before it's done copying.
The contents of the input folder will now be in the zip file in the output folder.
I trying to rezise each subfolders first jpg and put it to new subfolder
Dim strFolderPath,objFSO
strDirectory= "D:\images\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFolder, objSubFolder,folderCur
Set objFolder = objFSO.GetFolder(strDirectory)
Dim imageMagick
Set imageMagick = CreateObject("ImageMagickObject.MagickImage.1")
If objFolder.SubFolders.Count > 0 Then
For Each objSubFolder in objFolder.SubFolders
'Now check if the folder contains any files.
If objSubFolder.Files.Count > 0 Then
folderCur = objSubFolder & "\_small320\"
For each JpgFile in objSubFolder.Files
WScript.Echo "Checking Folder: " & folderCur & "\" & JpgFile.name & vbcrlf & " File: " & JpgFile
if not objFSO.folderexists(folderCur) then objFSO.createfolder folderCur
'imageMagick.Exec("convert " & JpgFile & " -resize 320x210 " & JpgFile.name)
imageMagick.Convert JpgFile, "-resize", "320x210", folderCur & "\preview.jpg"
exit for
next
End If
Next
End If
But I get error on imageMagick.Convert JpgFile, "-resize", "320x210", folderCur & "\preview.jpg"
What is wrong with syntax?
also get this error
But all dlls exist in folder
Not tested (no ImageMagick at hand), but probably
imageMagick.Convert JpgFile.Path, "-resize", "320x210", folderCur & "preview.jpg"
Included full path to the file and removed an additional backslash in the output file (that was included in the folder name).
EDITED Now tested and working. This code processes subfolders of the folder where the script is placed.
Option Explicit
Const OUTPUT_FOLDER_NAME = "_small320"
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim strScriptFolder
strScriptFolder = fso.GetFile( WScript.ScriptFullName ).ParentFolder.Path
Dim rootFolder
Set rootFolder = fso.GetFolder( strScriptFolder )
Dim imageMagick
Set imageMagick = WScript.CreateObject("ImageMagickObject.MagickImage.1")
Dim inputFolder, inputFile, strOutputFolder
For Each inputFolder In rootFolder.SubFolders
If inputFolder.Name <> OUTPUT_FOLDER_NAME Then
strOutputFolder = fso.BuildPath(inputFolder.Path, OUTPUT_FOLDER_NAME)
If Not fso.FolderExists(strOutputFolder) Then
fso.CreateFolder strOutputFolder
End If
For Each inputFile In inputFolder.Files
Select Case LCase(fso.GetExtensionName(inputFile.Path))
Case "jpg", "jpeg", "png"
WScript.Echo "[ convert ] " & inputFile.Path
imageMagick.Convert inputFile.Path, _
"-resize", _
"320x210", _
fso.BuildPath(strOutputFolder, inputFile.Name)
Case Else
WScript.Echo "[ skip ] " & inputFile.Path
End Select
Next
End If
Next
The original error in question (Unsupported argument type) was generated when as argument a File object was passed, instead of a string with the file path.
The Unable to load module is an ImageMagick error, not a programming error. Maybe the path variable is wrong and the modules can not be found or it is a install error. The previous code has been tested (and works) with a fresh ImageMagick-6.9.1-6-Q16-x64-dll.exe install.
I'm fairly new to vbscript and programming! As I've already mentioned in the title, I've written (or at least I've tried) a vbscript which should copy and rename all files in C:\test\ and the subfolders of C:\test\ to a another Folder, named C:\test1.
Here's what I've got so far:
Dim objStartFolder, objtargetFolder, objDateCreatedName
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "C:\test"
objtargetFolder = "C:\test1"
Set objFolder = objFSO.GetFolder(objStartFolder)
WScript.Echo objFolder.Path
Set colFiles = objFolder.Files
For Each objFile In colFiles
WScript.Echo objFile.Name
Next
WScript.Echo
ShowSubFolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
For Each Subfolder In Folder.SubFolders
WScript.Echo Subfolder.Path
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile In colFiles
Set objDateCreatedName = objFSO.GetFile(objStartFolder)
WScript.Echo objDateCreatedName.DateCreated
WScript.Echo "I'm going to copy " & objFolder.Path & objFile.Name & " to " & objtargetFolder & objtargetFolder & objFile.Name & "."
Next
WScript.Echo
ShowSubFolders Subfolder
Next
End Sub
It would be really nice if you could help me and if you need more Information I'll make sure to deliver them.
If every file should go into the same destination folder you could simply do something like this:
Set fso = CreateObject("Scripting.FileSystemObject")
Function Pad(s)
Pad = Right("00" & s, 2)
End Function
Sub CopyFiles(fldr, dst)
'Copy all files from fldr to destination folder and append the date (in ISO
'format) to the name. Overwrite existing files.
For Each f In fldr.Files
created = Year(f.DateCreated) & "-" & Pad(Month(f.DateCreated)) & "-" & _
Pad(Day(f.DateCreated))
newname = fso.GetBaseName(f) & "_" & created & "." & fso.GetExtensionName(f)
f.Copy fso.BuildPath(dst, newname), True
Next
'Recurse into subfolders.
For Each sf In fldr.SubFolders
CopyFiles sf, dst
Next
End Sub
CopyFiles fso.GetFolder("C:\test"), "C:\test1"