Reputation: 153
I got the following code to capture information for files on a specified drive, I ran the script againts a 600 GB hard drive on one of our servers and after a while I get the error
Out of String space; "Join". Line 34, Char 2
For this code, file script.vbs:
Option Explicit
Dim objFS, objFld
Dim objArgs
Dim strFolder, strDestFile, blnRecursiveSearch
''Dim strLines
Dim strCsv
''Dim i
'' i = 0
' 'Get the commandline parameters
' Set objArgs = WScript.Arguments
' strFolder = objArgs(0)
' strDestFile = objArgs(1)
' blnRecursiveSearch = objArgs(2)
'########################################
'SPECIFY THE DRIVE YOU WANT TO SCAN BELOW
'########################################
strFolder = "C:\"
strDestFile = "C:\InformationOutput.csv"
blnRecursiveSearch = True
'Create the FileSystemObject
Set objFS=CreateObject("Scripting.FileSystemObject")
'Get the directory you are working in
Set objFld = objFS.GetFolder(strFolder)
'Open the csv file
Set strCsv = objFS.CreateTextFile(strDestFile, True)
'' 'Write the csv file
'' Set strCsv = objFS.CreateTextFile(strDestFile, True)
strCsv.WriteLine "File Path,File Size,Date Created,Date Last Modified,Date Last Accessed"
'' strCsv.Write Join(strLines, vbCrLf)
'Now get the file details
GetFileDetails objFld, blnRecursiveSearch
'' 'Close and cleanup objects
'' strCsv.Close
'' 'Write the csv file
'' Set strCsv = objFS.CreateTextFile(strDestFile, True)
'' For i = 0 to UBound(strLines)
'' strCsv.WriteLine strLines(i)
'' Next
'Close and cleanup objects
strCsv.Close
Set strCsv = Nothing
Set objFld = Nothing
Set strFolder = Nothing
Set objArgs = Nothing
'---------------------------SCAN SPECIFIED LOCATION-------------------------------
Private Sub GetFileDetails(fold, blnRecursive)
Dim fld, fil
dim strLine(4)
on error resume next
If InStr(fold.Path, "System Volume Information") < 1 Then
If blnRecursive Then
'Work through all the folders and subfolders
For Each fld In fold.SubFolders
GetFileDetails fld, True
If err.number <> 0 then
LogError err.Description & vbcrlf & "Folder - " & fold.Path
err.Clear
End If
Next
End If
'Now work on the files
For Each fil in fold.Files
strLine(0) = fil.Path
strLine(1) = fil.Size
strLine(2) = fil.DateCreated
strLine(3) = fil.DateLastModified
strLine(4) = fil.DateLastAccessed
strCsv.WriteLine Join(strLine, ",")
if err.number <> 0 then
LogError err.Description & vbcrlf & "Folder - " & fold.Path & vbcrlf & "File - " & fil.Name
err.Clear
End If
Next
End If
end sub
Private sub LogError(strError)
dim strErr
'Write the csv file
Set strErr = objFS.CreateTextFile("C:\test\err.log", false)
strErr.WriteLine strError
strErr.Close
Set strErr = nothing
End Sub
RunMe.cmd
wscript.exe "C:\temp\script\script.vbs"
How can I avoid getting this error? The server drives are quite a bit <????> and I would imagine that the CSV file would be at least 40 MB.
Edit by Guffa:
I commented out some lines in the code, using double ticks ('') so you can see where.
Upvotes: 1
Views: 2969
Reputation: 700302
This line joins all the lines into a huge string and writes to the file:
strCsv.Write Join(strLines, vbCrLf)
Instead, write the lines one by one:
For i = 0 to UBound(strLines)
strCsv.WriteLine strLines(i)
Next
Edit:
To write directly to the file without storing the lines in an array first, you open the file before calling GetFileDetails, and write the string to the file instead of adding it to the array:
...
'Open the csv file
Set strCsv = objFS.CreateTextFile(strDestFile, True)
'Now get the file details
GetFileDetails objFld, blnRecursiveSearch
'Close and cleanup objects
strCsv.Close
...
In the loop in the subroutine you write to the file
...
For Each fil in fold.Files
strLine(0) = fil.Path
strLine(1) = fil.Size
strLine(2) = fil.DateCreated
strLine(3) = fil.DateLastModified
strLine(4) = fil.DateLastAccessed
strCsv.Write Join(strLine, ",")
Next
...
Upvotes: 2