title: How to monitor a folder with all subfolders and within the subfolder
body: <p>I am currently working on a vbscript that monitors subfolders. But right now, I want the script to monitor the folders in the subfolder.</p>
  
  <p>For example: the map is 'imports'. And in the import folder there are several folders (subfolders). And in the subfolder there are more several folders, and that is what I want to monitor. </p>
  
  <p>I hope this is clear to understand what I mean. </p>
  
  <p>Example: <a href="http://gyazo.com/3f0b7a9d492361fef41fbbe9760a8da1" rel="nofollow">http://gyazo.com/3f0b7a9d492361fef41fbbe9760a8da1</a></p>
  
  <p>Example 2: <a href="http://gyazo.com/284734da6b70d1b91ac7e3afc4e10918" rel="nofollow">http://gyazo.com/284734da6b70d1b91ac7e3afc4e10918</a></p>
  
  <p>This is what I have right now:</p>
  
  <pre><code>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:" &amp; vbcrlf  _ 
    &amp; "=============================" &amp; vbcrlf 
  if not (rs.bof and rs.eof) then 
     rs.sort = "moddate asc" 
     rs.movefirst 
     do until rs.eof 
    s = s &amp; rs("foldername") &amp; ";" _ 
        &amp; rs("moddate") &amp; 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.
  </code></pre>