VBScript超出字符串空间

时间:2010-02-22 14:00:06

标签: vb.net vbscript

我得到以下代码来捕获指定驱动器上的文件信息,我在我们的一台服务器上运行了一个600 GB的硬盘驱动器,过了一段时间我得到了错误

  

超出字符串空间; “加入”。   第34行,第2行

对于此代码,请输入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"

如何避免收到此错误?服务器驱动器是相当多的&lt; ????&gt;我想这个CSV文件至少有40 MB。

Guffa编辑:
我在代码中注释掉了一些行,使用双刻度(''),这样你就可以看到。

1 个答案:

答案 0 :(得分:2)

此行将所有行连接成一个巨大的字符串并写入文件:

strCsv.Write Join(strLines, vbCrLf)

相反,逐行写下这些行:

For i = 0 to UBound(strLines)
   strCsv.WriteLine strLines(i)
Next

编辑:
要直接写入文件而不先将行存储在数组中,请在调用GetFileDetails之前打开该文件,然后将该字符串写入文件,而不是将其添加到数组中:

...
'Open the csv file
Set strCsv = objFS.CreateTextFile(strDestFile, True)

'Now get the file details
GetFileDetails objFld, blnRecursiveSearch 

'Close and cleanup objects
strCsv.Close
...

在子程序的循环中,您将写入文件

...
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
...