jazzman060
11-05-2007, 12:36 PM
Hello All -
I am trying to create a macro that will prompt the user to select a folder to open, and then list all the file names that appear in that folder and all sub-folders within. The code below pretty much works (for some reason it does not pull files that only have numeric characters) but there is one more step i would like it to do. I am trying to not only get the macro to pull the name of the file, but also the name of the folder directly above it in another column. If anyone can advise how to do so I would be most appreciative. Thank you all for your time.
-d
Dim myFolder As String
Sub SelectFolder(Optional i_RootFolder As String)
Dim myShell As Object
Set myShell = CreateObject("Shell.Application")
If i_RootFolder = "" Then
'no root folder given, use default (which is Desktop)
Set myFolder = myShell.BrowseForFolder(0, "Please select a folder:", 1)
ElseIf Not (i_RootFolder Like "*[!0123456789]*") Then
'number for special folder given
Set myFolder = myShell.BrowseForFolder(0, _
"Please select a folder:", 1, CInt(i_RootFolder))
Else
'path for root folder given
Set myFolder = myShell.BrowseForFolder(0, _
"Please select a folder:", 1, CStr(i_RootFolder))
End If
If Not myFolder Is Nothing Then
SelectFolder = myFolder.Self.path
End If
End Sub
Sub TestListFilesInFolder()
'Dim folder As String
' folder = (myFolder)
Sheets.Add
With ActiveSheet
.Move after:=Worksheets(1)
.Name = "All Part #'s"
End With
Range("A1").Value = "Part #"
Range("B1").Value = "All Subparts"
Range("A1:B1").Font.Bold = True
ListFilesInFolder myFolder, True
' list all files included subfolders
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.Name
' FileItem.Delete True
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
I am trying to create a macro that will prompt the user to select a folder to open, and then list all the file names that appear in that folder and all sub-folders within. The code below pretty much works (for some reason it does not pull files that only have numeric characters) but there is one more step i would like it to do. I am trying to not only get the macro to pull the name of the file, but also the name of the folder directly above it in another column. If anyone can advise how to do so I would be most appreciative. Thank you all for your time.
-d
Dim myFolder As String
Sub SelectFolder(Optional i_RootFolder As String)
Dim myShell As Object
Set myShell = CreateObject("Shell.Application")
If i_RootFolder = "" Then
'no root folder given, use default (which is Desktop)
Set myFolder = myShell.BrowseForFolder(0, "Please select a folder:", 1)
ElseIf Not (i_RootFolder Like "*[!0123456789]*") Then
'number for special folder given
Set myFolder = myShell.BrowseForFolder(0, _
"Please select a folder:", 1, CInt(i_RootFolder))
Else
'path for root folder given
Set myFolder = myShell.BrowseForFolder(0, _
"Please select a folder:", 1, CStr(i_RootFolder))
End If
If Not myFolder Is Nothing Then
SelectFolder = myFolder.Self.path
End If
End Sub
Sub TestListFilesInFolder()
'Dim folder As String
' folder = (myFolder)
Sheets.Add
With ActiveSheet
.Move after:=Worksheets(1)
.Name = "All Part #'s"
End With
Range("A1").Value = "Part #"
Range("B1").Value = "All Subparts"
Range("A1:B1").Font.Bold = True
ListFilesInFolder myFolder, True
' list all files included subfolders
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.Name
' FileItem.Delete True
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub