使用文件系统对象来创建名称与字符串匹配的文件的日志

时间:2014-02-07 15:56:45

标签: vbscript filesystemobject

我有一个目录,其中包含许多嵌套在不同文件夹和子文件夹中的同名文件。我正在尝试创建一个vbs脚本,它将搜索目录并找到任何名为“history”的文件,并将修改后的名称,路径和日期写入文件。

我已经成功地制作了一个脚本来返回文件夹中的所有文件,但是还没能成功,所以只有那些名为“历史”的文件才会被写入。我试图在for中添加一个If语句,所以它会像:

For Each ObjFolder In ObjSubFolders
    If ObjFolder.Name = "history*.*" Then
    ResultLogFile.WriteLine(ObjFolder.Name & vbab & ObjFolder.Path)
End If

但那不起作用

这是我到目前为止所做的:

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fso
Dim OutputFileName
Dim ResultLogFile


vCurrentDate = Now
'Year string
vCurrentYear = CStr(DatePart("yyyy",vCurrentDate))

'Month string
If DatePart("m",vCurrentDate) < 10 Then
    vCurrentMonth = "0" & CStr(DatePart("m",vCurrentDate))
Else
    vCurrentMonth = CStr(DatePart("m",vCurrentDate))
End If

'Day string
If DatePart("d",vCurrentDate) < 10 Then
    vCurrentDay = "0" & CStr(DatePart("d",vCurrentDate))
Else
    vCurrentDay = CStr(DatePart("d",vCurrentDate))
End If  

Set fso = CreateObject("Scripting.FileSystemObject")

OutputFileName = "C:\historylogs\" & vCurrentYear & "-" & vCurrentMonth & "-" & vCurrentDay & ".tsv"

'MySourcePath = "C:\Test Folder\"
'Check if file already exists:

If fso.FileExists(OutputFileName) Then
    'File exists, so open it for appending and add no new header info:
    Set ResultLogFile = fso.OpenTextFile(OutputFileName, ForAppending, True, TristateTrue)
Else
    'File did not exist, so create it and add a header
    Set ResultLogFile = fso.OpenTextFile(OutputFileName, ForWriting, True, TristateTrue)
    'Create log headers
    ResultLogFile.WriteLine "FileName" & vbTab & "FilePath" & vbTab & "DateLastModified"
End If

GetFiles("C:\Test Folder")

Function GetFiles(FolderName)
    'On Error Resume Next

Dim ObjFolder
Dim ObjSubFolders
Dim ObjSubFolder
Dim ObjFiles
Dim ObjFile 

Set ObjFolder = fso.GetFolder(FolderName)
Set ObjFiles = ObjFolder.Files

'Write all files to output files
For Each ObjFile In ObjFiles
    ResultLogFile.WriteLine(ObjFile.Name & vbTab & ObjFile.Path & vbTab & ObjFile.DateLastModified)
Next
'Getting all subfolders
Set ObjSubFolders = ObjFolder.SubFolders

For Each ObjFolder In ObjSubFolders
    'Writing SubFolder Name and Path
    ResultLogFile.WriteLine(ObjFolder.Name & vbab & ObjFolder.Path)

    'Getting all Files from subfolder
    GetFiles(ObjFolder.Path)
Next

End Function

1 个答案:

答案 0 :(得分:1)

你可以通过几种方式做到这一点..改变这个......

For Each ObjFile In ObjFiles
  ResultLogFile.WriteLine(ObjFile.Name & vbTab & ObjFile.Path & vbTab & ObjFile.DateLastModified)
Next

..您希望在名称中找到任何具有历史记录的文件,无论在何处:

For Each ObjFile In ObjFiles
  If InStr(1, ObjFile.Name, "history") Then
    ResultLogFile.WriteLine(ObjFile.Name & vbTab & ObjFile.Path & vbTab & ObjFile.DateLastModified)
  End If
Next

..您想查找以历史记录开头的所有文件:

For Each ObjFile In ObjFiles
  If LCase(Mid(ObjFile.Name, 1, 7)) = "history" Then
    ResultLogFile.WriteLine(ObjFile.Name & vbTab & ObjFile.Path & vbTab & ObjFile.DateLastModified)
  End If
Next

编辑:回复你的评论,你可以像这样有一个递归子。它将搜索所有文件夹和子文件夹,以查找以您传递的任何内容开头的任何文件..因此,如果您传递“历史记录”,则会找到文件历史*。

Set objFSO = CreateObject("Scripting.FileSystemObject")

Call findFiles(objFSO.GetFolder("C:\temp"), "history")

Sub findFiles(objFolder, strMatchString)

  For Each objSubFolder In objFolder.SubFolders
    Call findFiles (objSubFolder, strMatchString)
  Next

  Set objFiles = objFolder.Files

  For Each objFile In objFiles
    If LCase(Mid(objFile.Name, 1, Len(strMatchString))) = LCase(strMatchString) Then
      MsgBox objFile.Name & vbTab & objFile.Path & vbTab & objFile.DateLastModified
    End If
  Next 
End Sub