I found online script that basically unzip every .zip archive in a given path.
sub UnzipAll(path)
set folder = fso.GetFolder(path)
for each file in folder.files
if (fso.GetExtensionName(file.path)) = "zip" then
set objShell = CreateObject("Shell.Application")
objshell.NameSpace(path).CopyHere objshell.NameSpace(file.path).Items
file.delete
end if
next
end sub
This is actually working, but the problem is that I want to unzip "silently" (silently means that I don't want any kind of message from the system when unzipping, like "do you want to overwrite?" ect.).
I've searched a lot on google and I found that you just need to add a few flags on the "CopyHere" method, like this:
objshell.NameSpace(path).CopyHere objshell.NameSpace(file.path).Items, *FLAGHERE*
But the problem is right here. The flags would normally work, but they are completely ignored when unzipping a .zip archive.
So I searched for a workaround, but I didn't find anything helpful.
I managed to do it by myself. Basically you want to unzip 1 file per time and not everyone togheter, and before copying it you just check if it already exists, and evenutally delete it:
set fso = CreateObject("Scripting.FileSystemObject")
sub estrai(percorso)
set cartella = fso.GetFolder(percorso)
for each file in cartella.files
if fso.GetExtensionName(file.path) = "zip" then
set objShell = CreateObject("Shell.Application")
set destinazione = objShell.NameSpace(percorso)
set zip_content = objShell.NameSpace(file.path).Items
for i = 0 to zip_content.count-1
'msgbox fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path)
if (fso.FileExists(fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path))) then
'msgbox "il file esiste, ora lo cancello"
fso.DeleteFile(fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path))
end if
destinazione.copyHere(zip_content.item(i))
next
file.Delete
end if
next
'for each sottocartella in cartella.subfolders
' call estrai(folder.path)
'next
end sub
call estrai("C:\Documents and Settings\Mattia\Desktop\prova")
Related
My main goal is to check if a folder exists in a zip file.
For that I'm trying to go through the various files and folders. I use the following code for that:
strFile = "C:\Users\temp.zip"
Set objApp = CreateObject("Shell.Application")
Set objContents = objApp.NameSpace(strFile).Items()
For Each objItem in objContents
WScript.Echo objItem.Name
If objItem.IsFolder Then
GetSubFolders(objItem)
End If
Next
Sub GetSubFolders(objSubItem)
Set objFolder = objSubItem.GetFolder
For Each objItem2 in objFolder.Items()
WScript.Echo objItem2.Name
If objItem2.IsFolder Then
GetSubFolders(objItem2)
End If
Next
End Sub
The problem is I can't seem to figure out, how to check which level I am on.
I thought about this:
levelDepth = Len(strFile) - Len(Replace(strFile, "\", ""))
which tells me how "deep" the zip file is. If I could get the full path of objItem and objItem2, then I could use the same method. Subtract the two from each other and get how deep in the zip file the current directory or file is.
The Path property should give you the full path of an item.
I need to take a list of computers (IP or PC name) that are all on the same domain in CSV format. Scan each computer for a specific folder name. The folder will be arcXXXof. The x's are a hash and change for each PC. If the folder is found it needs to output the folder path to a CSV and append with each computer scanned. My programming is limited and I only really know Java. Since this will be run from a server it will need local administrative privileges to run on the local machines. My manager suggested I use VBS, but I have never written in that before.
My current snag is getting an error "expected then" Here's my loop.
Sub Recurse(strFolderPath)
Dim objFolder
Set objFolder = objFSO.GetFolder(strFolderPath) 'reads Folders pulled from recursion
Dim objSubFolder
dim folderStart 'grabs the first 2 characters of the file name. Should match 'of' if correct folder
Dim folderEnd 'grabs the last 6 (test) characters of the folder name, should match arc.txt if correct
Global checkEnd
set checkEnd = "arc" 'checks for "arc" at ending
Global checkStart
set checkStart = "of" 'used to check if folder name is correct path
For Each objSubFolder in objFolder 'for every Folder scanned
'Scans the name of the Folder, objSubFolder, for an ending of “arc", and beginning of “of” (testing)
set folderName = objSubFolder.name
Set folderEnd = right(folderName, 3)
set folderStart = left(folderName, 2)
dim folderName
if folderName = testFolderName
then WScript.Echo objSubFolder
'If folderEnd = checkEnd and
'If folderStart = checkStart
'Add Folder location to array, set array to next object
'Then fLocations(i) = object.GetAbsolutePathName(objSubFolder) and i = i+1
else
End If
Next
'recursive for searching new folder
For Each objSubFolder in objFolder.Subfolders
Call Recurse(objSubFolder.Path)
Next
OK, you could use a regex to match the name. Define it up front, in your global scope:
Dim re
Set re = New RegExp
re.IgnoreCase = True
re.Pattern = "^arc\w{3}of$"
I'm using \w, which is equivalent to [a-zA-Z_0-9]. You can change this if you're expecting only digits (\d) or something else for these three chars.
Then, in your Recurse function, test the folder name against it:
For Each objSubFolder in objFolder.SubFolders
' See if this folder name matches our regex...
If re.Test(objSubFolder.Name) Then
' Match. Just display for now...
WScript.Echo objSubFolder.Path
End If
' Test its subfolders...
Recurse objSubFolder.Path
Next
Tip: Remove the On Error Resume Next from your code while you're developing or you might miss all kinds of bugs and cause all kinds of headaches.
I have next to zero knowledge on vbs scripting but I have managed to cobble a few together to copy files from one directory to another and delete files in a directory but I've not been able to find anything specifically what I'm now after.
I'm looking to write a vbs script to do the following - copy file/s beginning with XXX or YYY or ZZZ from directory A to directory B.
I've had a look around and cannot quite find what I'm looking for, they all seem far too complex for what I need and involve the latest date or parsing a string within the files etc.
I'm quite sure this is simple but as stated at the top I really do not know what I'm doing so any help would be greatly appreciated.
The following is what I have for copying all files from one directory to another with a progress bar so a amendment to this would be great.
Const FOF_CREATEPROGRESSDLG = &H0&
' copy test 1 to test 2
strTargetFolder = "C:\test2\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(strTargetFolder)
objFolder.CopyHere "C:\test1\*.*", FOF_CREATEPROGRESSDLG
Not sure as of yet how to get this in one big progress indicator. Currently it will show progress for each individual file.
Const FOF_CREATEPROGRESSDLG = &H0&
strSourceFolder = "C:\test1\"
strTargetFolder = "C:\test2\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSourceFolder = objFSO.GetFolder(strSourceFolder)
Set objFiles = objSourceFolder.Files
Set objShell = CreateObject("Shell.Application")
Set objTargetFolder = objShell.NameSpace(strTargetFolder)
For Each objSingleFile in objFiles
If (InStr(1,objSingleFile.Name,"xxx",vbTextCompare) = 1) Or _
(InStr(1,objSingleFile.Name,"yyy",vbTextCompare) = 1) Or _
(InStr(1,objSingleFile.Name,"zzz",vbTextCompare) = 1) Then
' The file name starts with one the flagged keywords
objTargetFolder.CopyHere objSingleFile.Path, FOF_CREATEPROGRESSDLG
End If
Next
Keep your strTargetFolder code which is used for the actual copy procedure used at the end of the script. Using the FileSystemObject objFSO we cycle through all the files of the directory c:\test1. Each file name is then checked to see if it starts with either of 3 different strings. The comparison is done using vbTextCompare which essentially has it running case insensitive. If a match is found then, using your original code, copy the file to the target directory with progress.
Currently this is not going to recursively navigate all subfolders for file but you could make a recursive function for that.
Use the FileSystemObject in combination with a regular expression:
src = "C:\test1"
dst = "C:\test2"
Set fso = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Pattern = "^(XXX|YYY|ZZZ)"
For Each f In fso.GetFolder(src).Files
If re.Test(f.Name) Then f.Copy dst & "\"
Next
I need to move a file with a name based off of a date to another folder.
The file structure is:
Source: \\network_location\folder\Filename_09-11-2012.txt
Destination: C:\Dump\Filename.txt
The source file is always 1 day behind. I am looking to rename the file while copying it.
The code I am trying to use is:
Sub Copy_And_Rename()
Name "\\network_location\folder\Filename_"+Month(Now())+"-"+Day(Now()-1)+"-"+Year(Now())+".txt" As "C:\Dump\Filename.txt"
End Sub
You can copy and rename a file with the FileSystemObject like this:
Set objFSO = CreateObject("Scripting.FileSystemObject")
' First parameter: original location\file
' Second parameter: new location\file
objFSO.CopyFile "C:\Test\folder1\name1.txt", "C:\Test\folder2\name2.txt"
Code to copy and rename file
sourceFilePath = "C:\filePath\source.xlsx"
destinationFilePath = "C:\filePath\destination.xlsx"
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile sourceFilePath, destinationFilePath
I'm getting an error when i use opentextfile. The problem is weird because it works for a few hundred files then pops up.
Basically the script gets a collection of files, searchs in them for a string which it then removes and writes back the modified content to the same file. The problem occurs when the script wants to open the file again so it can write the modified contents to it.
This is the code:
For Each objFile in colFiles
Set objCurrentFile = objFSO.OpenTextFile(objFile.Path, ForReading)
'Get file contents - exclude end tag '
Do Until objCurrentFile.AtEndOfStream
strLine = objCurrentFile.ReadLine
If InStr(strLine, strSearchTerm) = 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop
objCurrentFile.Close
objCurrentFile = nothing
'Write new file contents to existing file '
Set objNewFile = objFSO.OpenTextFile(objFile.Path, ForWriting) 'PROBLEM LINE '
objNewFile.Write strNewContents
objNewFile.Close
objNewFile = nothing
Next
The file is read-only.
Try adding this before you open the text file for writing. If the file is read-only it will remove the read-only attribute.
IsReadOnly = False
IF objFile.Attributes AND 1 Then
objFile.Attributes = objFile.Attributes - 1
IsReadOnly = True
End If
Then add this when you are done writing to the file. If the file was read-only set it back to read-only.
If IsReadOnly Then
objFile.Attributes = objFile.Attributes + 1
IsReadOnly= False
End If
I found the issue. I was opening the text file and then copying it to another folder and then performing more operations on the file before closing the stream.
Once i moved the copy file code to before i opened the stream it works perfectly.
Thanks for the help though, i'll use your code in the future to be safe when working with text files.
you can try givin total control permission to the folder where is the the file to read.