VBScript - 在循环中使用文件夹名称创建文本文件

问题描述:

问题: 下面的这个脚本循环播放超过4百万个文件并检索文件属性信息以确定可以清除的内容。目前的过程已经使用20 + GB的RAM,只有一半完成。VBScript - 在循环中使用文件夹名称创建文本文件

我一直在创建一个大的批处理文件来将每个子文件夹的内容写入一个新的文本文件。这是不实际的,因为它耗费时间,这是我将运行此过程的几台服务器中的第一台。

问题: - 是否有可能基于子文件夹循环创建一个新文件来写入? (使用对象属性代替文件似乎没有办法) - 是可以将内容写入文件,然后从我的临时内存中清除以前的数据?

Set objFSO = CreateObject("Scripting.FileSystemObject") 
objStartFolder = "C:\Test" 

Set objFolder = objFSO.GetFolder(objStartFolder) 
Set colFiles = objFolder.Files 

For Each objFile in colFiles 
    On Error Resume Next 
    If Err Then 
     MyFile.Write "Error accessing " & objFile & ": " & Err.Description & vbCrLf 
     Err.Clear 
    Else 
     Q="""" 'Wrap quotes around string 
     strFilePath = Q & objFile.Path & Q 
     strFileName = Q & objFile.Name & Q 
     strFileSize = objFile.Size 
     strFileType = Q & objFile.Type & Q 
     strFileDateCreated = objFile.DateCreated 
     strFileDateLastAccessed = objFile.DateLastAccessed 
     strFileDateLastModified = objFile.DateLastModified 
     Set objWMIService = GetObject("winmgmts:") 
     Set objFileSecuritySettings = _ 
     objWMIService.Get("Win32_LogicalFileSecuritySetting=""" & replace(objFile,  "\", "\\") & """") 
     intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD) 
     If intRetVal = 0 Then 
      strFileOwner = Q & objSD.Owner.Domain & "\" & objSD.Owner.Name & Q 
     Else 
      strFileOwner = Q & "Couldn't retrieve security descriptor." & Q 
     End If 

'    CreatedDiff = DateDiff("yyyy",strFileDateCreated,Now) 
'    AccessedDiff = DateDiff("yyyy",strFileDateLastAccessed,Now) 
'    ModifiedDiff = DateDiff("yyyy",strFileDateLastModified,Now) 
'    MaxTime = 3 'Max time in years. For days change "yyyy" to "d" 

'    If (CreatedDiff >= MaxTime) AND (AccessedDiff >= MaxTime) AND  (ModifiedDiff >= MaxTime) Then 

      MyFile.Write strFilePath & "~|~" &_ 
      strFileName & "~|~" &_ 
      strFileSize & "~|~" &_ 
      strFileType & "~|~" &_ 
      strFileDateCreated & "~|~" &_ 
      strFileDateLastAccessed & "~|~" &_ 
      strFileDateLastModified & "~|~" &_ 
      strFileOwner & vbCrLf 
'   End If 
    End If 
Next 

ShowSubfolders objFSO.GetFolder(objStartFolder) 

Sub ShowSubFolders(Folder) 
    For Each Subfolder in Folder.SubFolders 
    On Error Resume Next 
     Set objFolder = objFSO.GetFolder(Subfolder.Path) 
     Set colFiles = objFolder.Files 

    For Each objFile in colFiles 
    On Error Resume Next 
    If Err Then 
     MyFile.Write "Error accessing " & objFile & ": " & Err.Description & vbCrLf 
     Err.Clear 
    Else 
     Q="""" 'Wrap quotes around string 
     strFilePath = Q & objFile.Path & Q 
     strFileName = Q & objFile.Name & Q 
     strFileSize = objFile.Size 
     strFileType = Q & objFile.Type & Q 
     strFileDateCreated = objFile.DateCreated 
     strFileDateLastAccessed = objFile.DateLastAccessed 
     strFileDateLastModified = objFile.DateLastModified 
     Set objWMIService = GetObject("winmgmts:") 
     Set objFileSecuritySettings = _ 
     objWMIService.Get("Win32_LogicalFileSecuritySetting=""" & replace(objFile, "\", "\\") & """") 
     intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD) 
     If intRetVal = 0 Then 
      strFileOwner = Q & objSD.Owner.Domain & "\" & objSD.Owner.Name & Q 
     Else 
      strFileOwner = Q & "Couldn't retrieve security descriptor." & Q 
     End If 

'    CreatedDiff = DateDiff("yyyy",strFileDateCreated,Now) 
'    AccessedDiff = DateDiff("yyyy",strFileDateLastAccessed,Now) 
'    ModifiedDiff = DateDiff("yyyy",strFileDateLastModified,Now) 
'    MaxTime = 3 'Max time in years. For days change "yyyy" to "d" 

'    If (CreatedDiff >= MaxTime) AND (AccessedDiff >= MaxTime) AND (ModifiedDiff >= MaxTime) Then 

      MyFile.Write strFilePath & "~|~" &_ 
      strFileName & "~|~" &_ 
      strFileSize & "~|~" &_ 
      strFileType & "~|~" &_ 
      strFileDateCreated & "~|~" &_ 
      strFileDateLastAccessed & "~|~" &_ 
      strFileDateLastModified & "~|~" &_ 
      strFileOwner & vbCrLf 
'    End If 
    End If 
Next 
ShowSubFolders Subfolder 
Next 
End Sub 
+1

有这么多的数据要存储,你确定一个文本文件是你最好的选择?你有没有考虑过使用数据库?另外'On Error Resume Next'清除'Err'对象。所以你的'If Err Then'测试总是会是'False'。 – Bond 2014-09-11 12:36:52

+0

感谢您的意见。关于您直接存储到数据库的问题,最终我会将这些文件加载​​到MySQL数据库中。但是,凭借我有限的VBScript知识,我选择采用两步法。任何意见或建议,你可能会不胜感激。 – user3549887 2014-09-11 15:33:12

这是一个有点困难,告诉你如何做到这一点,因为你没有提供完整的脚本,因为你引用了未在您提供的代码实例化对象。

是的,你可以写每个文件夹的输出到一个新的文件以及可用内存。尽管你需要改变脚本的结构。我一直在为你做这件事,直到我遇到更多未定义的对象并放弃了,所以我只是告诉你该怎么做。

你不需要两个零件,只要一个就可以。这里的结构轮廓:

Dim fso, startfolder 
Set fso = CreateObject("Scripting.FileSystemObject") 

startfolder = "C:\temp" 
GetFileInfo startfolder 

Sub GetFileInfo(folderpath) 
    On Error Resume Next 
    Dim file, logpath, logfile, folder 
    logpath = "C:\log\" & fso.GetBaseName(folderpath) & ".log" ' C:\log folder must exist; but of course edit path and file name conventions as desired 
    Set logfile = fso.OpenTextFile(logpath, 2, True) 
    If Err Then EchoAndQuit "Failed to create log " & logpath & ": " & Err.Description 

    ' Write the file info in current folder 
    For Each file In fso.GetFolder(folderpath).Files 
     logfile.WriteLine file.Name ' file/security info 
    Next 

    'Set x = Nothing (Set objects instantiated in this sub to nothing to release memory) 

    ' Now the recursive bit 
    For Each folder In fso.GetFolder(folderpath).SubFolders 
     GetFileInfo(folder.Path) 
    Next 

    On Error GoTo 0 
End Sub 


Sub EchoAndQuit(msg) 
    MsgBox msg, 4096 + 16, "Failed" 
    WScript.Quit 
End Sub 

一个问题是,你会得到一个访问被拒绝的错误,如果你有多个同名的文件夹 - 我会离开它给你制定出一些检查/命名约定来避免这种情况。 (你可以通过设置logfile = nothing来避开它,但是如果有多个同名的文件夹,你会覆盖现有的日志文件,所以你可以设计一些日志文件检查/命名约定来避开重复名称问题,那么你可以销毁该对象,如果你想。)