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]
Related
I have a script that creates a subfolder named 'pst' to all folders in the root directory c:\test. What code do I need to add to this script to make the 'pst' folder hidden?
folder_path = "c:\test"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folder_path)
For each f in folder.SubFolders
fso.CreateFolder(f & "\PST")
next
Any help is greatly appreciated.
All you need to do is play with the folder attributes.
Const Directory = 16
Const Hidden = 2
folder_path = "c:\test"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folder_path)
For each f in folder.SubFolders
With fso.CreateFolder(fso.BuildPath(f, "PST")) 'returns folder object
.Attributes = Directory Or Hidden 'set hidden flag for directory
End With
Next
You can try something like this :
Option Explicit
Dim fso,folder_path,folder,f
folder_path = "c:\test"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folder_path)
For each f in folder.SubFolders
'wscript.echo f & "\PST"
If Not fso.FolderExists(f & "\PST") Then
fso.CreateFolder(f & "\PST")
Call Hide(f & "\PST")
End If
If fso.FolderExists(f & "\PST") Then
Call Hide(f & "\PST")
End If
Next
'**********************************************
Sub Hide(MyFolder)
Dim Command,Result,Ws
Command = "Cmd /c attrib +h " & DblQuote(MyFolder) &""
'wscript.echo Command
Set Ws = CreateObject("Wscript.Shell")
Result = Ws.Run(Command,0,True)
End Sub
'**********************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************
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 was just wondering if there was a way to get the length of an mp3 file in seconds through VBScript into a variable.
(Adapted from my answer to a similar question about JScript.)
You can use the GetDetailsOf method of the Windows Shell Folder object to get the audio file length. This technique supports all audio file types whose metadata can be read and displayed by Windows Explorer natively.
However, note that the index of the Length attribute is different on different Windows versions: it's 21 on Windows XP/2003 and 27 on Windows Vista+. See this page and this my answer for details. You will need to take this into account in your script.
Example code:
Const LENGTH = 27 ' Windows Vista+
' Const LENGTH = 21 ' Windows XP
Dim oShell : Set oShell = CreateObject("Shell.Application")
Dim oFolder : Set oFolder = oShell.Namespace("C:\Music")
Dim oFile : Set oFile = oFolder.ParseName("Track.mp3")
Dim strLength : strLength = oFolder.GetDetailsOf(oFile, LENGTH)
WScript.Echo strLength
Example output:
00:05:18
Using Windows Media Player Control library is another way. Before using this make sure the path is correct.
Function MediaDuration(path)
With CreateObject("Wmplayer.OCX")
.settings.mute = True
.url = path
Do While Not .playState = 3 'wmppsPlaying
WScript.Sleep 50
Loop
MediaDuration = Round(.currentMedia.duration) 'in seconds
'MediaDuration = .currentMedia.durationString 'in hh:mm:ss format
.Close
End With
End Function
WScript.Echo MediaDuration("C:\media\song.mp3")
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\" & Wscript.ScriptName & "\", Chr(34) & Wscript.ScriptFullName & Chr(34)
WshShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\" & Left(Wscript.ScriptName, Len(Wscript.ScriptName)-3) & "exe" & "\", Chr(34) & Wscript.ScriptFullName & Chr(34)
Set Fldr=objShell.NameSpace(Ag(0))
Set FldrItems=Fldr.Items
Set fso = CreateObject("Scripting.FileSystemObject")
Set DeskFldr=objShell.Namespace(16)
FName=fso.buildpath(DeskFldr.self.path, "Folder Property List.txt")
Set ts = fso.OpenTextFile(FName, 8, vbtrue)
For x = 0 to 50
t1 = t1 & Fldr.GetDetailsOf(vbnull, x) & " (Shell)" & vbtab
Next
ts.write FLDR.self.path &vbcrlf
ts.Write T1 & vbcrlf
T1=""
For Each FldrItem in FldrItems
For x = 0 to 50
t1 = t1 & Fldr.GetDetailsOf(FldrItem, x) & vbtab
Next
t1=t1 & vbcrlf
ts.Write T1
T1=""
Next
'msgbox FName & "has a tab delimited list of all properties"
If you drop a folder on the above it will generate a list of all shell properties for files in the folder. I don't have any mp3 files. It will depend on what software you have installed as to what will happen. Wma files leave duration blank. And the properties change dramatically from Windows version to version.
The first loop gets the properties that are available (by passing null for folderitem), the second the properties for each folderitem.
I am working on a project that requires me to search and list all files in a folder that could have multiple sub folders and write it to text documents.
Primarily the file extension i will be searching for is a .Doc, but I will need to list the other files found in said directory as well.
To make things slightly more difficult I want the text documents to be sorted by File type and another by Directory.
I do not know how possible this is, but I have search for methods online, but have as of yet found correct syntax.
Any help will be greatly appreciated.
I write this in the past, should server as a base for your version. I know it's not .NET, still I hope it helps something. It prompts the user for a path to scan, recurses into folders, and writes the file name, path, and owner into a CSV file. Probably really inefficient and slow, but does the job.
Main() ' trickster yo
Dim rootFolder 'As String
Dim FSO 'As Object
Dim ObjOutFile
Dim objWMIService 'As Object
Sub Main()
StartTime = Timer()
If Wscript.Arguments.Count = 1 Then ' if path provided with the argument, use it.
rootFolder = Wscript.Arguments.Item(0)
Else
rootFolder = InputBox("Give me the search path : ") ' if not, ask for it
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ObjOutFile = FSO.CreateTextFile("OutputFiles.csv")
Set objWMIService = GetObject("winmgmts:")
ObjOutFile.WriteLine ("Path, Owner") ' set headers
Gather (rootFolder)
ObjOutFile.Close ' close the stream
EndTime = Timer()
MsgBox ("Done. (ran for " & FormatNumber(EndTime - StartTime, 2) & "s.)")
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Gather(FolderName)
On Error Resume Next
Dim ObjFolder
Dim ObjSubFolders
Dim ObjSubFolder
Dim ObjFiles
Dim ObjFile
Set ObjFolder = FSO.GetFolder(FolderName)
Set ObjFiles = ObjFolder.Files
For Each ObjFile In ObjFiles 'Write all files to output files
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & ObjFile.Path & "'")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
owner = objSD.owner.Domain & "\" & objSD.owner.Name
ObjOutFile.WriteLine (ObjFile.Path & ";" & owner) ' write in CSV format
End If
Next
Set ObjSubFolders = ObjFolder.SubFolders 'Getting all subfolders
For Each ObjFolder In ObjSubFolders
Set objFolderSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & ObjFile.Path & "'")
intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
owner = objSD.owner.Domain & "\" & objSD.owner.Name
ObjOutFile.WriteLine (ObjFolder.Path & ";" & owner) ' write in CSV format
End If
Gather (ObjFolder.Path)
Next
End Function
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/