I'm trying to get a CSV output for a Blender render job duration estimation. I like to input file time stamps into an Excel, so I wrote below VBScript (it's not 100% ready, but the echo should work). However, it won't iterate beyond the 1000th png file. It ends at file 9999.
Currently I got 35432 png files.
Why won't VBScript go beyond 1000 files?
Option Explicit 'force all variables to be declared
Const ForWriting = 2
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTS 'Text Stream Object
Set objTS = objFSO.OpenTextFile("C:\tmp\output.txt", ForWriting, True)
Recurse objFSO.GetFolder("C:\tmp")
objTS.Close()
Sub Recurse(objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "png" Then
WScript.Echo objFSO.GetBaseName(objFile.Name) & vbTab & _
CDate(objFile.DateLastModified) & vbTab & _
CDate(objFile.DateCreated)
objTS.WriteLine(objfile.Path)
End If
Next
'unmark to make it recursive
'For Each objSubFolder In objFolder.SubFolders
' Recurse objSubFolder
'Next
End Sub
Related
I'm creating a script that will allow a user to search within a specified directory with a search term. The script will create a CSV file and then write the base file name, the file size, the last modified date, and the absolute path of files that contain the search term within the file name. However, I'm running into an issue searching subfolders within the folder. The issue is that I'm running out of memory within the subroutine.
Here is the script I've written thus far.
Dim fileCount, searchPath, searchTerm, CheckFile, wholePath
Dim objFSO, objFolder, objFile, objWriteFile
Dim savePath
objCheckFile = "C:\Users\USERFILE\Desktop\Audit.csv"
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Asks for directory to search in
searchPath = InputBox("Please enter the path of the folder you would like to search", "Where am I searching?")
Set objFolder = objFSO.GetFolder(searchPath)
'Asks for the search term to use
searchTerm = InputBox("Please enter the term you would like to search for", "What am I searching?")
If objFSO.FileExists(objCheckFile) Then
WScript.Echo "Please delete the file named Audit.csv before trying again"
Else
Set objWriteFile = objFSO.CreateTextFile("Audit.csv", ForWriting, True)
End If
Set colFiles = objFolder.Files
Set colFolders = objFolder.SubFolders
'Searches for files within the folder and writes to a CSV file
For Each objFile In colFiles
If InStr(LCase(objFSO.GetFileName(objFile)), LCase(searchTerm)) > 0 Then
objWriteFile.Write objFSO.getFileName(objFile) & ", "
objWriteFile.Write objFile.size & ", "
objWriteFile.Write objFile.DateLastModified & ", "
objWriteFile.Write objFSO.getAbsolutePathName(objFolder) & objFSO.getFileName(objFile)
objWriteFile.Writeline
End If
Next
ShowSubFolder objFolder
Sub ShowSubFolder(Folder)
If InStr(LCase(objFSO.GetFileName(objFile)), LCase(searchTerm)) > 0 Then
objWriteFile.Write objFSO.getFileName(objFile) & ", "
objWriteFile.Write objFile.size & ", "
objWriteFile.Write objFile.DateLastModified & ", "
objWriteFile.Write objFSO.getAbsolutePathName(objFolder) & objFSO.getFileName(objFile)
objWriteFile.Writeline
End If
For Each objSubFolder In colFolders
ShowSubFolder objSubFolder
Next
End Sub
Your recursion never terminates because of this:
Set colFiles = objFolder.Files
Set colFolders = objFolder.SubFolders
'...
ShowSubFolder objFolder
Sub ShowSubFolder(Folder)
'...
For Each objSubFolder In colFolders
ShowSubFolder objSubFolder
Next
End Sub
This is similar to a fork bomb. For each subfolder of objFolder you recurse again into each subfolder of objFolder. And again. And again. And ...
Change your code to this and it should do what you want:
Set colFiles = objFolder.Files
'...
ShowSubFolder objFolder
Sub ShowSubFolder(Folder)
'...
For Each objSubFolder In Folder.SubFolders
ShowSubFolder objSubFolder
Next
End Sub
You may also want to adjust the conditional inside the recursive procedure, because it uses objFile and objFolder that are defined outside the procedure.
I am trying to copy file using following script.
Option Explicit
Const ForWriting = 2
Dim objFSO
Dim desfolder
Dim oShell
dim s
desfolder = "D:\Databases"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Recurse objFSO.GetFolder("D:\Databases\Images")
Sub Recurse(objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "tif" Then
s = Right(objFile.Name, 10)
S = Left(s, 1)
If Left(s, 1) = "C" Then
Set oShell = WScript.CreateObject("WScript.Shell")
oShell.Run "xcopy.exe " & objFile & " " & desfolder & " /R /Y", _
0, True
End If
End If
Next
For Each objSubFolder In objFolder.SubFolders
Recurse objSubFolder
Next
End Sub
What I am trying to do is checking files in folders and subfolders. If file is tif then checking weather it contains required letter "C" at specific position. and using xcopy to copy the file.
It works fine but is very slow.
Is there any faster method to do this?
Edit: What I want exactly is to find c*.tif in a folder and its subfolders.
Don't use xcopy then. Doing it your way spawns a new process each time you copy a file. Just use the file object's Copy method and be done with it.
Sub Recurse(objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile)) = "tif" Then
If LCase(Left(objFile.Name, 1) = "c" Then
objFile.Copy desfolder & "\"
End If
End If
Next
For Each objSubFolder In objFolder.SubFolders
Recurse objSubFolder
Next
End Sub
Note that your destination path requires a trailing backslash because it's a folder (you'd get a "permission denied" error without it). Otherwise you need to specify the destination path including the filename, e.g. like this:
objFile.Copy objFSO.BuildPath(desfolder, objFile.Name)
I am using the following code:
Set StorageFileSystem = CreateObject("Scripting.fileSystemObject")
Set StorageFolder = StorageFileSystem.GetFolder(PathToStorageFiles)
msgBox "Set folders for Storage"
for each Storagefile in StorageFolder.Files 'get the creation time of the oldest recording
msgBox "DateCreated: " & Storagefile.DateCreated & vbCrLf & "EarylDateTime: " & earlyDateTime & vbCrLf & "DateTime to compare: " & dateadd("h" ,-6, Now)
if Storagefile.DateCreated < dateadd("h" ,-6, Now) then
earlyDateTime = Storagefile.DateCreated
end if
next
I have used this before without problem, even in the program that this is in. However this time it never seems to do anything. The folder has over 130,000 files in it (391GB). I don't know if I should include a delay so that the program can emumerate them or if there is some other problem that I just don't see.
Any ideas? I'm using VBS, the msgBox between the 2 set statements and the for loop works, but the one between the opening of the for loop and the if statement does not.
Are you saying the codes in the For loop doesn't seem to work? It seems not work if the folder does not have any files in it. So check the value of PathToStorageFiles.
Your logic of getting the oldest recording creation time is flawed - any time that is 6 hours before Now is treated as oldest and set to earlyDateTime.
Try this code below, with sample output:
PathToStorageFiles = "C:\Test" ' <=- Change this!
Set StorageFileSystem = CreateObject("Scripting.fileSystemObject")
Set StorageFolder = StorageFileSystem.GetFolder(PathToStorageFiles)
sOldestFile = "" ' Stores the full name of the file
earlyDateTime = dateadd("h" ,-6, Now) ' Assuming 6 hours before script started is oldest (it can be just Now)
wscript.echo StorageFolder.Files.Count & " files in the folder " & PathToStorageFiles
for each Storagefile in StorageFolder.Files 'get the creation time of the oldest recording
if Storagefile.DateCreated < earlyDateTime then
sOldestFile = Storagefile.Path
earlyDateTime = Storagefile.DateCreated
wscript.echo "earlyDateTime changed to " & earlyDateTime & " | " & sOldestFile
end if
next
wscript.echo vbCrLf & "Oldest file: " & sOldestFile & vbCrLf & "Created on: " & earlyDateTime
On a side note, you should modify this to process sub folders too, then move files into folders. 130,000 files in a single folder is a mess!
UPDATE
Based on your posted solution, there are improvements you can do.
First, use 1 FileSystemObject.
Then the recentFile in the for loop. You should set it to zero first, rather than 2 comparisons. Having said that, you have the opportunity to time the differences.
recentFile = 0
For Each file in colFiles
If file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Lastly, if the D: on the server is a NAS, then you can split the code into 2 parts - one search for most recent, the other for oldest. Then use batch file start cscript.exe //nologo <script#.vbs> method to start them in 2 processes. This you need 2 txt files for output.
If there is only 1 folder to get the latest & oldest file, it can be in 1 for loop.
This is the code that I got to work:
Option Explicit
Dim LocalStorage, NewLocalStorage, recentFile, objFSO, colFiles, objFolder, file, OldestDate, strOldestDate, fso, ts, objFile
LocalStorage = "D:\BlueIris\Storage"
NewLocalStorage = "D:\BlueIris\New"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(NewLocalStorage)
Set colFiles = objFolder.Files
For Each file in colFiles
If recentFile = "" Then
recentFile = file.DateCreated
ElseIf file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Set objFolder = objFSO.GetFolder(LocalStorage)
Set colFiles = objFolder.Files
OldestDate = Now
For Each objFile in colFiles
if objFile.DateCreated < OldestDate Then
OldestDate = objFile.DateCreated
strOldestDate = objFile.DateCreated
End if
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile ("C:\DVRInfo.txt", true)
ts.writeline recentFile
ts.writeline strOldestDate
ts.close
I run this on the actual server so that it runs a lot faster than the original code I attempted. Let me know if you still flaws in this please, I want to be as efficient as possible.
Thanks
EDIT:
New code:
Option Explicit
Dim LocalStorage, NewLocalStorage, recentFile, objFSO, colFiles, objFolder, file, OldestDate, strOldestDate, fso, ts, objFile
LocalStorage = "D:\BlueIris\Storage"
NewLocalStorage = "D:\BlueIris\New"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(NewLocalStorage)
Set colFiles = objFolder.Files
Set recentFile = 0
For Each file in colFiles
If file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Set objFolder = objFSO.GetFolder(LocalStorage)
Set colFiles = objFolder.Files
OldestDate = Now
For Each objFile in colFiles
if objFile.DateCreated < OldestDate Then
OldestDate = objFile.DateCreated
strOldestDate = objFile.DateCreated
End if
Next
Set ts = fso.CreateTextFile ("C:\DVRInfo.txt", true)
ts.writeline recentFile
ts.writeline strOldestDate
ts.close
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
In this script I try to rename all the files within a folder. The new names I will gather from each textfiles in itself using Instr(1, strText, "(Amtlicher Gemeindeschlüssel = " ...). So all jsp-files shall be proceed. But I get an object-error almost at the end: 800A01A8 - Object Required. Can anyone helpme to replace the object strVerz.files so the the code works.
Thank U in advance.
Michael
Dim objFso, strFolder
' Begin Main
Set objFso = CreateObject("Scripting.FileSystemObject")
strFolder = objFso.GetParentFolderName(WScript.ScriptFullName)
If objFso.FolderExists(strFolder) Then
Call GetJspFiles(objFso.GetFolder(strFolder))
End If
Set objFso = Nothing
' End Main
Sub GetJspFiles(ByRef objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFso.GetExtensionName(objFile.Name)) = "jsp" Then
Call JSPRename(objFile.Path, objFolder.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Call GetJspFiles(objSubFolder)
Next
' objFile.Close
End Sub
Sub JSPRename(ByRef strPath, ByRef strFolder)
Dim arrText, strText, strTextLine, Position , objJspFile, newFilename, strVerz
Set objJspFile = objFso.OpenTextFile(strPath)
arrText = Split(objJspFile.ReadAll, vbCrLf) ' split to lines
For Each strTextLine In arrText
If strTextLine <> "" Then
strText = Trim(strTextLine)
If Instr(1,strText,"(Amtlicher Gemeindeschlüssel",1) Then
Position=Instr(1, strText, "(Amtlicher Gemeindeschlüssel =",1)
newFilename=mid(strText,Position+31, 8)
else
end if
end if
Next
strVerz=objFSO.GetParentFoldername(WScript.ScriptFullName)
strNewName = strVerz & "\" & newFilename & ".jsp"
' Wscript.echo strNewName & vbcrlf & strVerz.files '!! only for Showing the results
objFSO.MoveFile strVerz.files, strNewName <- Here I get the error
objJspFile.Close
End Sub
It seems like the purpose of JSPRename is to rename the file given by strPath. In that case, the call to MoveFile should look like:
objFSO.MoveFile strPath, strNewName