carcharoth2554
New Member
- Joined
- Feb 5, 2013
- Messages
- 30
Hi guys,
Excel 2010 in Win 7 64bit
I am adapting some code I found in another thread to first list all files found in a target directory and then want it to do some basic sorting. All I am really stuck on is getting the sub ListFilesInFolder() to list the different sub-directories in separate columns; at the moment it reads them all into the same column. I have tried a few approaches on this but cannot figure where I should be putting my column count increase (Dim t). Please see attached code.
Another problem I have had with this code is how slow it is. I have tried adding Application.ScreenUpdating modifiers which cut the processing time in half but for 300+ files I am still looking at 41 seconds. Is there anything that can be done to speed this up or is it just a very large amount of data it is having to handle?
I appreciate any input as you guys have been great in the past.
Thanks!
Excel 2010 in Win 7 64bit
I am adapting some code I found in another thread to first list all files found in a target directory and then want it to do some basic sorting. All I am really stuck on is getting the sub ListFilesInFolder() to list the different sub-directories in separate columns; at the moment it reads them all into the same column. I have tried a few approaches on this but cannot figure where I should be putting my column count increase (Dim t). Please see attached code.
Another problem I have had with this code is how slow it is. I have tried adding Application.ScreenUpdating modifiers which cut the processing time in half but for 300+ files I am still looking at 41 seconds. Is there anything that can be done to speed this up or is it just a very large amount of data it is having to handle?
I appreciate any input as you guys have been great in the past.
Thanks!
Code:
Sub GetDirectory()
Application.Calculation = xlCalculationManual
Dim CheckPath As String
Dim Msg As Byte
Dim Drilldown As Boolean
CheckPath = "O:\Timesheets and Forms\2013 Timesheets\Test Folder"
Worksheets("Register").Range("A1:H999").ClearContents
If CheckPath = "" Then
MsgBox "No folder was selected. Procedure aborted.", vbExclamation, "StaffSmart Add-In"
Exit Sub
End If
Msg = MsgBox("Do you want to list all files in subfolders, too?", _
vbInformation + vbYesNo, "Drill-Down")
If Msg = vbYes Then Drilldown = True Else Drilldown = False
' add headers
Application.ScreenUpdating = False
With Range("A1")
.Value = CheckPath
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "Folder:"
Range("A3:H3").Font.Bold = True
ListFilesInFolder CheckPath, Drilldown
' list all files included subfolders
Range("a4").Select
ActiveWindow.FreezePanes = True
Range("a3").Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlYes
Range("a3").Select
ActiveWindow.LargeScroll Up:=100
Application.ScreenUpdating = True
MsgBox "Done", vbOKOnly, "StaffSmart Add-In"
End Sub
Private Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Object 'Scripting.FileSystemObject
Dim SourceFolder As Object 'Scripting.Folder
Dim SubFolder As Object 'Scripting.Folder
Dim FileItem As Object 'Scripting.File
Dim r As Integer
Dim t As Integer
Dim c As Integer
Dim strAddress As String
Dim strDisplayText As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
t = 1
' If "descendant" folders also get their files listed, then sub calls itself recursively
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
t = t + 1
Next SubFolder
End If
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, t).Value = FileItem.Name
Worksheets("Register").Hyperlinks.Add Anchor:=Cells(r, t), Address:=FileItem.ParentFolder.Path & "\" & FileItem.Name
r = r + 1 ' next row number
Next FileItem
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub