karsten....@givaudan.com
unread,Jul 25, 2012, 5:55:39 AM7/25/12You do not have permission to delete messages in this group
Either email addresses are anonymous for this group or you need the view member email addresses permission to view the original message
to
Hallo
leider bin ich keine Experte auf dem Gebiet und für schaut es so aus, als ob dort num eine kleinigkeit geändert werden müsste:
Ziel ist es , alle Dateinen in allen Unterordner in die Exceltablle zu bringen
Es script läuft auch aber nur soweit, das immer nur der angebene Ordner druchsucht wird.
Es sollen aber auch die unterordner durchucht werden
Kann mir da jemand helfen ?
Danke und Gruß
M. Lang
--------
strDirectoryFolder = InputBox ("Enter Directory Folder Name")
'strDirectoryFolder= temp
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "File Name"
objExcel.Cells(1, 2).Value = "Last Accessed"
objExcel.Cells(1, 3).Value = "Folder Name"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objDirectory = Fso.GetFolder(strDirectoryFolder)
For Each objFile in objDirectory.Files
objExcel.Cells(intRow, 1).Value = objFile.Name
objExcel.Cells(intRow, 2).Value = objFile.DateLastAccessed
objExcel.Cells(intRow, 3).Value = objFile.Path
intRow = intRow + 1
Next
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
Set objRange = objExcel.Range("A2")
objRange.Sort objRange,1,,,,,,1
MsgBox "Done"