27. juni 2008 - 09:48
Der er
4 kommentarer og
1 løsning
Traversering af mapper efter unikke filer, én folder ad gangen
Hej,
Jeg vil gerne ha' hjælp til at anvende Application.FileSearch, således at man i excel lister indholdet udtømmende af én undermappe, før man går videre til at liste næste undermappes indhold.
I sin standardfunktion er Application.Filesearch.Foundfiles desværre ikke sorteret i mappeorden - kan jeg det på en nem måde?
BAGGRUND:
Min opgave er at traversere en gigantisk filstruktur igennem og identificere unikke filer. Jeg vil liste dubletter i et excel-ark med filnavn og placering. Dubletter skal efterfølgende IKKE indlæses i en intranet google search applikation.
Vi har haft en tendens til blot at gemme opdaterede filer i nye versioner i samme mappe som gamle filer. Derfor vil der i mange mapper ligge 20+ gamle versioner af samme fil, som ikke skal importeres.
Jeg vil finde den nyeste fil, og alene importere den (2 filer er "ens" hvis xx%(variabel, fx 80%) af et filnavn er ens, er de pr. definition ens, og jeg vil kun importere den senest modificerede af de to. Jeg ved at jeg rammer ved siden af i xx pct. af tilfældende, men det kan jeg leve med...
Min køreplan:
Stien der skal analyseres = N:\dok
I denne mappe ligger 50.000+ filer i mere end 1000 mapper/undermapper. Mappenivaeu er mange niveauer ned - fx 6 niveauer.
1. Find første undermappe, fx N:\dok\mappe1
2. Er der undermapper, find undermappe, fx N:\dok\mappe1\undermappe1\
3. er der undermapper? NEJ - list i excel de fundne filer på hver sin linje.
4. Før man går til næste undermappe, udfør logik til at konkludere om der er tale om unikke filer.
Hjælp :o)
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
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!
