Traversering af mapper efter unikke filer, én folder ad gangen

Hej,

Du kan bruge dette VB script og tilrettet det:


  rootfolder = Inputbox("Enter directory/foldername: " & _
                        chr(10) & chr(10) & "(i.e. C:\Program Files or " & _
                        "\\Servername\C$\Program Files)" & chr(10) & chr(10), _
                        "Getfoldersize", "C:\Program Files")

  outputfile = "c:\foldersize_" & Day(now) & Month(now) & Year(now) & ".xls"

  Set fso = CreateObject("scripting.filesystemobject")
  if fso.fileexists(outputfile) then fso.deletefile(outputfile)

'Create Excel workbook
  set objXL = CreateObject( "Excel.Application" )
  objXL.Visible = False
  objXL.WorkBooks.Add

'Counter 1 for writing in cell A1 within the excel workbook
  icount = 1

'Run checkfolder
  CheckFolder (FSO.getfolder(rootfolder))

Sub CheckFolder(objCurrentFolder)

      For Each objFolder In objCurrentFolder.SubFolders
        FolderSize = objFolder.Size
        Tmp = (FormatNumber(FolderSize, 0, , , 0)/1024)/1024
        ObjXL.ActiveSheet.Cells(icount,1).Value = objFolder.Path
        ObjXL.ActiveSheet.Cells(icount,2).Value = Tmp
        'Wscript.Echo Tmp & " " & objFolder.Path
    'raise counter with 1 for a new row in excel
        icount = icount + 1
      Next

      'Recurse through all of the folders
      For Each objNewFolder In objCurrentFolder.subFolders
              CheckFolder objNewFolder
      Next
     
End Sub


'sort data in excel
objXL.ActiveCell.CurrentRegion.Select
objXL.Selection.Sort objXL.Worksheets(1).Range("B1"), _
                  2, _
                  , _
                  , _
                  , _
                  , _
                  , _
                  0, _
                  1, _
                  False, _
                  1

'Lay out for Excel workbook
  objXL.Range("A1").Select
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert

  objXL.Columns(1).ColumnWidth = 60
  objXL.Columns(2).ColumnWidth = 15
  objXL.Columns(2).NumberFormat = "#,##0.0"
  objXL.Range("B1:B1").NumberFormat = "d-m-yyyy"
  objXL.Range("A1:B5").Select
  objXL.Selection.Font.Bold = True
  objXL.Range("A1:B3").Select
  objXL.Selection.Font.ColorIndex = 5
  objXL.Range("A1:A1").Select
  objXL.Selection.Font.Italic = True
  objXL.Selection.Font.Size = 16
  ObjXL.ActiveSheet.Cells(1,1).Value = "Survey FolderSize "
  ObjXL.ActiveSheet.Cells(1,2).Value = Day(now) & "-" & Month(now) & "-"& Year(now)
  ObjXL.ActiveSheet.Cells(3,1).Value = UCase(rootfolder)
  ObjXL.ActiveSheet.Cells(5,1).Value = "Folder"
  ObjXL.ActiveSheet.Cells(5,2).Value = "Total (MB)"


'Finally close the workbook
  ObjXL.ActiveWorkbook.SaveAs(outputfile)
  ObjXL.Application.Quit
  Set ObjXL = Nothing

'Message when finished
  Set WshShell = CreateObject("WScript.Shell")
  Finished = Msgbox ("Script executed successfully, results can be found in " & Chr(10) _
                    & outputfile & "." & Chr(10) & Chr(10) _
                    & "Do you want to view the results now?", 65, "Script executed successfully!")
  if Finished = 1 then WshShell.Run "excel " & outputfile

Scriptet løber din filstryuktur igennem og generere et excelark med de filer det finder. Du kan blot modificere scriptet og ligge de kriterer ind som du vil have smidt ind i regnearket. F.eks ved at ligge en IF sætning ind.

Håber det kan bruges

Tak for input - jeg prøver det lige af hen over weekenden og giver en tilbagemelding.

Det virker.
Tricket var selvfølgelig strukturen i
Sub chechfolder, der indeholder et kald til sig selv m.

For Each objNewFolder In objCurrentFolder.subFolders
    CheckFolder objNewFolder
Next

Det havde jeg glemt som løsningsmodel - tak for input. Herefter er det forholdsvist nemt at lave en kombination af file-search i den enkelte mappe (uden undermapper) og dernæst rekursivt kalde sig selv (CheckFolder) med hver identificeret undermappe og foretage samme gennemløb.

Jeg takker!

welcome :)