i have a directory with subfolders. These subfolders have subfolders as well. For all Folders exist a timestamp with the time when they were last modified.
For example:
Folder1(21.01.2010)
-subfolder1(22.01.2010)
-subfolder2(23.01.2010)
--subfolder1(24.01.2010)
--subfolder2(25.01.2010)
Folder2(26.01.2010)
-subfolder 1(27.01.2010)
What I need is a script that checks the latest "date modified".
So the Output should be "27.01.2010".
I dont know how to start... is there a function which can list all folders??
Maybe you can help me... thank you in advance!
To get a list of folders and modified dates
Sub GetLastModified(folderspec)
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 in fc
s = s & f1.Name
s = s & f1.DateLastModified
s = s & vbCrLf
Next
MsgBox s
End Sub
Then you just need to iterate to find all folders WITHIN those folders and keep a record of the latest modified date
keep the template:
dim fs, foldercollection ,filecollection, folders, files
Set fs=CreateObject("Scripting.FileSystemObject")
Set fileobject = fs.GetFolder("c:\")
Set foldercollection = fileobject.SubFolders
folders = ""
files = ""
For Each folder in foldercollection
folders = folders & folder.name & Chr(13)
Next
Set foldercollection=nothing
Set filecollection = fileobject.Files
For Each file in filecollection
files = files & file.name & Chr(13)
next
MsgBox folders & files
Related
Original question:
I am quite unskillful with VBScript but would need an efficient solution for saving me lots of time selecting and copying files manually:
I have a folder with thousands raster files containing values of daily temperature for a certain area, altogether covering a period of 30 years.
In order to calculate monthly means out of 30 or 31 files per month (within a programme for geospatial data), I need to copy them into separate folders, e. g. the files from 2000 January 1 to 31 (named tx_20000101, tx_20000102 and so forth) into a folder named T_01_Jan_2000 and accordingly for all other months and years.
So I need a script, that searches for different text strings (YYYYMM) within all file names and moves the matched files into the given folder (for each search string a separate folder).
How could that be accomplished with VBScript?
With examples found in forums (mainly this: https://stackoverflow.com/a/29001051/6093207), I have come so far:
Option Explicit
Sub Dateien_verschieben()
Dim i
Dim FSO : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Quelle : Set Quelle = FSO.GetFolder("C:\Users\…\Temperature")
Dim Ziel1 : Set Ziel1 = FSO.GetFolder("C:\Users\…\Temperature\T_01_Jan\T_01_Jan_2000")
Dim Ziel2 : Set Ziel2 = FSO.GetFolder("C:\Users\…\Temperature\T_02_Feb\T_02_Feb_2000")
…
Dim Ziel12 : Set Ziel12 = FSO.GetFolder("C:\Users\…\Temperature\T_12_Dez\T_12_Dez_2000")
Dim Str1, Str2, Str3, Str4, Str5, Str6, Str7, Str8, Str9, Str10, Str11, Str12
Str1 = "200001"
Str2 = "200002"
…
Str12 = "200012"
i = 0
For Each file in Quelle.files
x = fso.getbasename(file)
If instr(lcase(x), Str1) Then
i = i+1
If fso.fileexists(Ziel1 & "\" & file.name) Then
fso.deletefile Ziel1 & "\" & file.name, True
End If
fso.movefile Quelle & "\" & file.name, Ziel1
ElseIf instr(lcase(x), Str12) Then 'I have omitted the other ElseIf statements here for reasons of clarity
i = i+1
If fso.fileexists(Ziel12 & "\" & file.name) Then
fso.deletefile Ziel12 & "\" & file.name, True
End If
fso.movefile Quelle & "\" & file.name, Ziel12
End If
Next
If i>0 Then
wscript.echo i&" files moved to path " & vbcrlf & Quelle
wscript.quit()
End If
wscript.echo "No matches found"
End Sub
However, I get different errors like 800A0414 and 800A0046, and did not get the script running yet as intended.
Any suggestions for correcting the code or for more efficent ways of scripting are welcome.
Edited question:
Having a folder with several thousands netCDF-files containing values of daily temperature for a certain area, altogether covering a period of 30 years, how is it possible to move them into separate folders monthwise?
The month folders should contain subfolders for the respective year.
So the files are named tx_20000101.nc, tx_20000102.nc and so forth and are altogether in the folder Temperature.
Now all files from January should come into a folder name T_01, which contains subfolders named T_01_1991, T_01_1992 and so on, accordingly for all other months and years.
How can this be accomplished by VBScript?
The solution (thanks to #Les Ferch):
Move = True 'Set to False for Copy
SrcDir = ".\Temperature" Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Source = oFSO.GetFolder(SrcDir)
For Each File in Source.Files
FileName = Right(File,11)
YYYY = Mid(FileName,1,4)
MM = Mid(FileName,5,2)
MonthDir = SrcDir & "\T_" & MM & "\"
YearDir = MonthDir & "T_" & MM & "_" & YYYY & "\"
If Not oFSO.FolderExists(MonthDir) Then oFSO.CreateFolder(MonthDir)
If Not oFSO.FolderExists(YearDir) Then oFSO.CreateFolder(YearDir)
If Move Then oFSO.MoveFile(File),YearDir Else oFSO.CopyFile(File),YearDir
Next
I need to recursively search for multiple files through the C:\Users directory tree recursively.
If I find any of the specified files in any of the sub-directories, I want to echo out the full path.
Here is what I have:
Dim fso,folder,files,sFolder,newFolder
Dim arr1
arr1 = Array("myFile1.pdf","myFile2.pdf","myFile3.pdf","nutbag.rtf","whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\Users"
Set folder = fso.GetFolder(sFolder)
Set files = folder.SubFolders
For each folderIdx In files
IF (Instr(folderIdx.Name,"Default") <> 1) Then
If (Instr(folderIdx.Name,"All Users") <> 1) Then
newFolder = sfolder & "\" & folderIdx.Name
CopyUpdater fso.GetFolder(newFolder)
End If
End If
Next
Sub CopyUpdater(fldr)
For Each f In fldr.Files
For Each i in arr1
If LCase(f.Name) = i Then
WScript.echo(f.name)
End If
Next
Next
For Each sf In fldr.SubFolders
CopyUpdater sf
Next
End Sub
If I run it as 'Administrator', I get:
VBScript runtime error: Permission Denied
If I run it as 'Local System' user, I get:
VBScript runtime error: Path not found
If I add, 'On Error Resume Next' to the beginning to suppress the errors, I get nothing back.
I have placed a text file called 'whoa.txt' in numerous locations around the C:\Users sub-dirs.
My suspicion is that it is a Windows permissions thing, but I am unsure.
Thanks much.
First I didn't use your code, it confuses me what you are trying to accomplish.
Next you should run the script in Administrator mode command prompt. This should allow you to check if the file is there.
Then paste code below to a vbs file and cscript it. This code displays all the matched filenames.My idea is that instead of going through all files in any folder for a matching filename, check if those wanted files exists in that folder - this is generally faster as some folders contains hundreds of files if not thousands (check your Temp folder!).
Option Explicit
Const sRootFolder = "C:\Users"
Dim fso
Dim arr1
Dim oDict ' Key: Full filename, Item: Filename
Main
Sub Main
arr1 = Array("myFile1.pdf", "myFile2.pdf", "myFile3.pdf", "nutbag.rtf", "whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDict = CreateObject("Scripting.Dictionary")
' Call Recursive Sub
FindWantedFiles(sRootFolder)
' Display All Findings from Dictionary object
DisplayFindings
Set fso = Nothing
Set oDict = Nothing
End Sub
Sub FindWantedFiles(sFolder)
On Error Resume Next
Dim oFDR, oItem
' Check if wanted files are in this folder
For Each oItem In arr1
If fso.FileExists(sFolder & "\" & oItem) Then
oDict.Add sFolder & "\" & oItem, oItem
End If
Next
' Recurse into it's sub folders
For Each oFDR In fso.GetFolder(sFolder).SubFolders
FindWantedFiles oFDR.Path
Next
End Sub
Sub DisplayFindings()
Dim oKeys, oKey
oKeys = oDict.Keys
For Each oKey In oKeys
wscript.echo oKey
Next
End Sub
There are 2 shared drives. One of them has a very complex folder structure. I would like to replicate the entire folder structure of Share 1 to Share 2. However I don't want to make duplicate files, rather I would want a shortcut or symbolic links to be present in the 2nd share. I tried to do this with existing tools like Robocopy and mklink and failed to achieve the result. Any Ideas to resolve this issue is highly appreciated.
You can do achieve this by Using the filesystemobject to work it's way down the folder structure, if the folder exists in the destination, do nothing and create shortcuts in that folder for all the hosting folders files. Otherwise, create the folder and create the shortcuts for the hosting files anyway.
The DoFolder sub widdles it's way down through all the subfolders.
The GetFN Function collects only the filenames of all the files in the hosting folder. Even if there are periods in the filename.
This was a fun program to write, thanks.
FolderShadows.vbs
Dim fso, HostFolder, DestFolder
'Host Folder - Folder must exist.
HostFolder = "C:\From\Folder"
'Destination Folder - Folder must exist.
DestFolder = "D:\To\Folder"
Set fso = CreateObject("Scripting.FileSystemObject")
DoFolder fso.GetFolder(HostFolder)
Sub DoFolder(Folder)
Dim SubFolder
If fso.folderexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder)) = False Then
fso.createfolder(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder))
End If
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
Dim FileName, shortcut
If (fso.fileexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk") = False) Then
FileName = Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk"
Set shortcut = CreateObject("WScript.Shell").CreateShortcut(FileName)
shortcut.Description = "Shortcut To " & File.Name
shortcut.TargetPath = fso.GetAbsolutePathName(Folder) & "\" & File.Name
shortcut.Save
End If
Next
End Sub
Function GetFN(FileName)
Dim Result, i
Result = FileName
i = InStrRev(FileName, ".")
If ( i > 0 ) Then
Result = Mid(FileName, 1, i - 1)
End If
GetFN = Result
End Function
Note: This script can run on an automated schedule, as it is built to auto update the shortcuts and folders if new files/folders are found.
I am having a problem with my script not actually producing a zip file. When I test the script with the paths set to something like this:
C:\Users\Bob\Desktop\Folder1\Folder2
with the test log files in folder 1 being deleted if older than 7 days, and being zipped and moved to folder 2, it will run perfectly fine. It will produce the zipped file with all of the log files in it and have the proper naming set.
So I know that at least the logic of the script works for that.
My problem is that I need this script to go through the security logs on a machine and delete any older than 7 days, and then zip up any that are left and be sent to a mounted shared drive. When I change the path to something like:
C:\Windows\System32\Config (where the logs are located)
it will still delete any log files older than 7 days, but it does not produce a zip file with any that are left. It just does nothing even though the script produces no errors. I've been trying to figure this out with no luck going over my code. If anyone could take a look over what I've had and let me know where I've gone astray that would be extremely helpful.
Thank you in advance, the script is found below.
'READ FIRST
'------------------------------------------------------------------------------------------
'Lines 14-53 delete any log files older than 7 days. Changing the value in "iDaysOld =" will change the time frame in which files are kept or deleted.
'If files do not need to be deleted this part of the script can be taken out and the Archive/Move ability will still be intact
'Lines 57-102 contain the ability to Zip your log files and send them to a new folder. The zipped file is named after the localhost and a date/timestamp is appended to the file name.
'------------------------------------------------------------------------------------------
Option Explicit
Dim oFSO, oFolder, sDirectoryPath
Dim oFileCollection, oFile, sDir
Dim iDaysOld
' Specify Directory Path From Where You want to clear the old files
sDirectoryPath = "C:\Windows\System32\config"
' Specify Number of Days Old File to Delete
iDaysOld = 7
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sDirectoryPath)
Set oFileCollection = oFolder.Files
For each oFile in oFileCollection
'Specify the Extension of file that you want to delete
'and the number with Number of character in the file extension
If LCase(oFSO.GetExtensionName(oFile.Name)) = "log" Then
If oFile.DateLastModified < (Date() - iDaysOld) Then
oFile.Delete(True)
End If
End If
Next
Set oFSO = Nothing
Set oFolder = Nothing
Set oFileCollection = Nothing
Set oFile = Nothing
WScript.Echo "Press to start zipping log files."
Dim objFile, objPath, objFolder, Command, PathLogs, RetVal
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objShell: Set objShell = CreateObject("WScript.Shell")
Dim d : d = Date()
Dim dateStr : dateStr = Year(d) & "-" & Right("00" & Month(d), 2) & "-" & Right("00" & Day(d), 2)
Dim t : t = Time()
Dim timeStr: timeStr = Hour(t) & "-" & Right("00" & Minute(t), 2) & "-" & Right("00" & Second(t), 2)
'Path where logs are located
PathLogs = "C:\Windows\System32\config"
'Loop through the logs and zip
Set objPath = objFSO.GetFolder(PathLogs)
For Each objFile In objPath.Files
If (LCase(objFSO.GetExtensionName(objFile)) = "log") Then
' zip files
Command = """C:\Program Files\7-zip\7z.exe"" a " & PathLogs & "%computername%" & "-" & dateStr & "-" & timeStr & ".zip " & PathLogs & objFile.Name
RetVal = objShell.Run(Command,0,true)
End If
Next
WScript.Echo "Zip Successful."
WScript.Echo "Now Moving Zipped Files into Archived Folder"
'move files
Set objFSO = CreateObject("Scripting.FilesystemObject")
objFSO.MoveFile "C:\Windows\System32\config\*.zip" , "C:\Testscripts\testfolder\Archived"
WScript.Echo "Move Successful."
I'd probably try echoing out the 7zip command line, checking that it looks right and running it manually from the same location as the script runs from. It might look wrong when you see it or 7zip might give you a message to indicate what's going on.
When extracting files from a ZIP file I was using the following.
Sub Unzip(strFile)
' This routine unzips a file. NOTE: The files are extracted to a folder '
' in the same location using the name of the file minus the extension. '
' EX. C:\Test.zip will be extracted to C:\Test '
'strFile (String) = Full path and filename of the file to be unzipped. '
Dim arrFile
arrFile = Split(strFile, ".")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(arrFile(0) & "\ ")
pathToZipFile= arrFile(0) & ".zip"
extractTo= arrFile(0) & "\ "
set objShell = CreateObject("Shell.Application")
set filesInzip=objShell.NameSpace(pathToZipFile).items
objShell.NameSpace(extractTo).CopyHere(filesInzip)
fso.DeleteFile pathToZipFile, True
Set fso = Nothing
Set objShell = Nothing
End Sub 'Unzip
This was working, but now I get a "The File Exists" Error.
What is the reason for this? Are there any alternatives?
All above solutions are accurate, but they are not definitive.
If you are trying to extract a zipped file into a temporary folder, a folder that displays "Temporary Folder For YOURFILE.zip" will immediately be created (in C:\Documents and Settings\USERNAME\Local Settings\Temp) for EACH FILE contained within your ZIP file, which you are trying to extract.
That's right, if you have 50 files, it will create 50 folders within your temp directory.
But if you have 200 files, it will stop at 99 and crash stating - The File Exists.
..
Apparently, this does not occur on Windows 7 with the contributions I view above. But regardless, we can still have checks. Alright, so this is how you fix it:
'========================
'Sub: UnzipFiles
'Language: vbscript
'Usage: UnzipFiles("C:\dir", "extract.zip")
'Definition: UnzipFiles([Directory where zip is located & where files will be extracted], [zip file name])
'========================
Sub UnzipFiles(folder, file)
Dim sa, filesInzip, zfile, fso, i : i = 1
Set sa = CreateObject("Shell.Application")
Set filesInzip=sa.NameSpace(folder&file).items
For Each zfile In filesInzip
If Not fso.FileExists(folder & zfile) Then
sa.NameSpace(folder).CopyHere(zfile), &H100
i = i + 1
End If
If i = 99 Then
zCleanup(file, i)
i = 1
End If
Next
If i > 1 Then
zCleanup(file, i)
End If
fso.DeleteFile(folder&file)
End Sub
'========================
'Sub: zCleanup
'Language: vbscript
'Usage: zCleanup("filename.zip", 4)
'Definition: zCleanup([Filename of Zip previously extracted], [Number of files within zip container])
'========================
Sub zCleanUp(file, count)
'Clean up
Dim i, fso
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 1 To count
If fso.FolderExists(fso.GetSpecialFolder(2) & "\Temporary Directory " & i & " for " & file) = True Then
text = fso.DeleteFolder(fso.GetSpecialFolder(2) & "\Temporary Directory " & i & " for " & file, True)
Else
Exit For
End If
Next
End Sub
And that's it, copy and paste those two functions into your VBScript hosted program and you should be good to go, on Windows XP & Windows 7.
Thanks!
You can use DotNetZip from VBScript.
To unpack an existing zipfile, overwriting any files that may exist:
WScript.echo("Instantiating a ZipFile object...")
Dim zip
Set zip = CreateObject("Ionic.Zip.ZipFile")
WScript.echo("Initialize (Read)...")
zip.Initialize("C:\Temp\ZipFile-created-from-VBScript.zip")
WScript.echo("setting the password for extraction...")
zip.Password = "This is the Password."
' set the default action for extracting an existing file
' 0 = throw exception
' 1 = overwrite silently
' 2 = don't overwrite (silently)
' 3 = invoke the ExtractProgress event
zip.ExtractExistingFile = 1
WScript.echo("extracting all files...")
Call zip.ExtractAll("extract")
WScript.echo("Disposing...")
zip.Dispose()
WScript.echo("Done.")
To create a new zipfile:
dim filename
filename = "C:\temp\ZipFile-created-from-VBScript.zip"
WScript.echo("Instantiating a ZipFile object...")
dim zip2
set zip2 = CreateObject("Ionic.Zip.ZipFile")
WScript.echo("using AES256 encryption...")
zip2.Encryption = 3
WScript.echo("setting the password...")
zip2.Password = "This is the Password."
WScript.echo("adding a selection of files...")
zip2.AddSelectedFiles("*.js")
zip2.AddSelectedFiles("*.vbs")
WScript.echo("setting the save name...")
zip2.Name = filename
WScript.echo("Saving...")
zip2.Save()
WScript.echo("Disposing...")
zip2.Dispose()
WScript.echo("Done.")
There's answers above which are perfectly correct, but I thought I'd wrap everything up into a full solution that I'm using:
strZipFile = "test.zip" 'name of zip file
outFolder = "." 'destination folder of unzipped files (must exist)
'If using full paths rather than relative to the script, comment the next line
pwd = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Set objShell = CreateObject( "Shell.Application" )
Set objSource = objShell.NameSpace(pwd+strZipFile).Items()
Set objTarget = objShell.NameSpace(pwd+outFolder)
intOptions = 256
objTarget.CopyHere objSource, intOptions
'Clean up
Set WshShell = CreateObject("Wscript.Shell")
tempfolder = WshShell.ExpandEnvironmentStrings("%temp%")
Set fso = CreateObject("Scripting.FileSystemObject")
Call fso.DeleteFolder(tempfolder + "\Temporary Directory 1 for " + strZipFile, True )
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23022290.html
Check your temp directory. If you have 99 folders associated with this unzipping process, try deleting them.
I added the following code to the beginning of my unzip procedure to delete these directories before I unzip:
For i = 1 To 99
If aqFileSystem.Exists(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip") = True Then
result = aqFileSystem.ChangeAttributes(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip", 1 OR 2, aqFileSystem.fattrFree)
Call DelFolder(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip")
Else
Exit For
End If
Next