如何監視包含所有子文件夾和子文件夾內的文件夾

Question

我目前正在處理監視子文件夾的vbscript。但現在，我希望腳本監控子文件夾中的文件夾。

例如：地圖是'進口'。在導入文件夾中有幾個文件夾（子文件夾）。在子文件夾中還有更多的文件夾，這就是我想監視的。

我希望這很清楚明白我的意思。

例子：http://gyazo.com/3f0b7a9d492361fef41fbbe9760a8da1

例2：http://gyazo.com/284734da6b70d1b91ac7e3afc4e10918

這就是我現在所擁有的：

Option Explicit 
Dim objExcel, strExcelPath, objSheet, fso, folder, colFolders, objFSO, objFile, objbook, objDoc,        objShell, rs, f, s, EmailBody, EmailAttachments, objWorkbook, strFile, IntRow, objRange, x,  objWorksheet,wbc, SaveChanges, objSubFolder, objFrigolanda, foldername, moddate,folders, Frigolanda 
Const adVarChar = 200 
Const adDate = 7 
Const adBigInt = 20 
'===== 
'Set objecten 
set fso = createobject("scripting.filesystemobject") 
set folder = fso.getfolder("\\netko-sbs\data\imports\") 
Set colFolders = folder.SubFolders 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFile = objFSO.CreateTextFile("\\netko-sbs\data\Imports\output.txt", True) 
'===== 
' Check if file exists. 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
If (objFSO.FileExists(strFile) = True) Then 
    objFSO.DeleteFile(strFile) 
End If 
'===== 
'create a custom disconnected recordset 
'with fields for filename, last modified date, and size. 
'===== 
set rs = createobject("ador.recordset") 
rs.fields.append "foldername",adVarChar,255 
rs.fields.append "moddate",adDate 
'rs.fields.append "filesize",adBigInt 
'==== 
'Excel 
'Set objWorksheet = objWorkbook.Worksheets(1) 
Set objExcel = CreateObject("Excel.Application") 
Set objWorkbook = objExcel.Workbooks.Open _ 
    ("\\netko-sbs\Data\Imports\output.xlsx") 'Opslaan als.. 
objExcel.Visible = True 'toon excel 
objExcel.DisplayAlerts = FALSE 'Foutmeldingen uitschakelen 
objExcel.Cells(1, 1).Value = "foldernaam" 'cellen naam geven 
objExcel.Cells(1, 2).Value = "Laatste import" 'cellen naam geven 

x = 2 'set de juiste rij in excel 
'===== 
'opening without any connection info makes 
'it "disconnected". 
'===== 
rs.open 
'===== 
'load it with file name, date, etc. 
'===== 
for each frigolanda in folder.SubFolders 
if frigolanda = "frigolanda" then 
set folderfrigo = fso.getfolder ("\\netko-sbs\data\imports\Frigolanda\") 
set colFolders = folder.SubFolders 
    end if 
next 
For each 



for each f in folder.SubFolders  
rs.addnew array("foldername","moddate"), _ 
      array(f.name,f.datelastmodified) 
rs.update 
next 
s = "Sortering van Oud naar Nieuw:" & vbcrlf _ 
    & "=============================" & vbcrlf 
if not (rs.bof and rs.eof) then 
    rs.sort = "moddate asc" 
    rs.movefirst 
    do until rs.eof 
    s = s & rs("foldername") & ";" _ 
     & rs("moddate") & vbcrlf 
    objExcel.Cells(x, 1).Value = _ 
     rs.Fields("foldername").Value 
    objExcel.Cells(x, 2).Value = _ 
     rs.Fields("moddate").Value 
     x = x + 1 
    rs.movenext 
loop 
end if 

objFile.WriteLine s 'Schrijf waarden naar Excel 
Set rs = nothing 'Gooi RS leeg 
Set folder = nothing 'Object leegmaken 
set fso = nothing 'Object leegmaken 

Set objRange = objExcel.Range("A1") 'Selecteer actieve cell 
objRange.Activate 'Activeer cell 

Set objRange = objExcel.ActiveCell.EntireColumn 
objRange.Autofit() 'Set grootte van kolom 

Set objRange = objExcel.Range("B1") 'Selecteer actieve cell 
objRange.Activate 'Activeer cell 

Set objRange = objExcel.ActiveCell.EntireColumn 
objRange.Autofit() 'Set grootte van kolom 


ObjWorkbook.SaveAs "\\netko-sbs\Data\Imports\output.xlsx" 'Excel bestand opslaan 
'objExcel.Quit 'Excel afsluiten als nodig is. 

Answer 1

您可以使用WMI和InstanceCreationEvent類通知文件或文件夾時被建造。 Here's a column from The Scripting Guy關於這個話題。它討論如何通知子文件夾正在創建，而不是文件，但這個想法是相同的。不幸的是，您只能監視一個文件夾，而不是文件夾層次結構。

因此，除了使用第三方工具之外，我能想到的唯一解決方案是迭代文件夾結構並將文件列表存儲在字典中。然後，以某個間隔輪詢文件夾以查看是否發生了任何更改。

例如：

Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set d = CreateObject("Scripting.Dictionary") 

' Initialize the file list... 
DoFolder "\\netko-sbs\data\imports", True 

' Now poll the folder every 10 seconds, looking for new files... 
Do 
    WScript.Sleep 10000 
    DoFolder "\\netko-sbs\data\imports", False 
Loop 

' Recursive function... 
Sub DoFolder(strFolder, bFirstTime) 

    ' Add each file to our dictionary... 
    For Each objFile In objFSO.GetFolder(strFolder).Files 

     If bFirstTime Then 

      ' Initializing. Just add every file we find... 
      d.Add objFile.Path, "" 

     Else 

      ' Polling. Report any new files... 
      If Not d.Exists(objFile.Path) Then 

       ' New file found! Do something with it. 

      End If 

     End If 

    Next 

    ' Recursively check each subfolder... 
    For Each objFolder In objFSO.GetFolder(strFolder).SubFolders 
     DoFolder objFolder.Path 
    Next 

End Sub 

這種運行一次，以建立文件夾層次結構的文件列表。然後，您可以在一段時間後再次運行該程序，以檢查是否有任何新的文件。