List Files (Specific File Type) from Folder & Sub-folders to Excel w/ VBA

[acerlaptop]

Hi Guys,

Anybody knows how to list all the PDF Files from a Folder and its Sub-folders to the Excel with VBA?

Thank you

 

[Yongle]

VBA below writes the list to the active sheet

place both procedures in the same module
amend "C:\FullPath\ToFolder\"
run ListFiles

Sub ListFiles()
    Application.ScreenUpdating = False
    ActiveSheet.Cells.Clear
    Call GetFiles("C:\FullPath\ToFolder\")      'end string with path separator ( \ )
End Sub

Private Sub GetFiles(ByVal path As String)
    Dim FSO As Object, Fldr As Object, subF As Object, File As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fldr = FSO.GetFolder(path)
   
    For Each subF In Fldr.SubFolders
        GetFiles (subF.path)
    Next subF

    For Each File In Fldr.Files
        If LCase(Right(File.path, 4)) = ".pdf" Then
            ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, 2) = Array(File.Name, Replace(File.path, File.Name, ""))
        End If
    Next File

    Set FSO = Nothing
    Set Fldr = Nothing
    Set subF = Nothing
    Set File = Nothing
End Sub

 

[acerlaptop]

VBA below writes the list to the active sheet

place both procedures in the same module
amend "C:\FullPath\ToFolder\"
run ListFiles

Sub ListFiles()
    Application.ScreenUpdating = False
    ActiveSheet.Cells.Clear
    Call GetFiles("C:\FullPath\ToFolder\")      'end string with path separator ( \ )
End Sub

Private Sub GetFiles(ByVal path As String)
    Dim FSO As Object, Fldr As Object, subF As Object, File As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fldr = FSO.GetFolder(path)
  
    For Each subF In Fldr.SubFolders
        GetFiles (subF.path)
    Next subF

    For Each File In Fldr.Files
        If LCase(Right(File.path, 4)) = ".pdf" Then
            ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, 2) = Array(File.Name, Replace(File.path, File.Name, ""))
        End If
    Next File

    Set FSO = Nothing
    Set Fldr = Nothing
    Set subF = Nothing
    Set File = Nothing
End Sub

Hi,

This is GREAT. Thank a LOT!!!!!

 

[acerlaptop]

VBA below writes the list to the active sheet

place both procedures in the same module
amend "C:\FullPath\ToFolder\"
run ListFiles

Sub ListFiles()
    Application.ScreenUpdating = False
    ActiveSheet.Cells.Clear
    Call GetFiles("C:\FullPath\ToFolder\")      'end string with path separator ( \ )
End Sub

Private Sub GetFiles(ByVal path As String)
    Dim FSO As Object, Fldr As Object, subF As Object, File As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fldr = FSO.GetFolder(path)
  
    For Each subF In Fldr.SubFolders
        GetFiles (subF.path)
    Next subF

    For Each File In Fldr.Files
        If LCase(Right(File.path, 4)) = ".pdf" Then
            ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, 2) = Array(File.Name, Replace(File.path, File.Name, ""))
        End If
    Next File

    Set FSO = Nothing
    Set Fldr = Nothing
    Set subF = Nothing
    Set File = Nothing
End Sub

Hi,

Can this code be used if I want to list 2 types of files, and also if I want to list all file.

Thanks in advance

 

[acerlaptop]

VBA below writes the list to the active sheet

place both procedures in the same module
amend "C:\FullPath\ToFolder\"
run ListFiles

Sub ListFiles()
    Application.ScreenUpdating = False
    ActiveSheet.Cells.Clear
    Call GetFiles("C:\FullPath\ToFolder\")      'end string with path separator ( \ )
End Sub

Private Sub GetFiles(ByVal path As String)
    Dim FSO As Object, Fldr As Object, subF As Object, File As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fldr = FSO.GetFolder(path)
  
    For Each subF In Fldr.SubFolders
        GetFiles (subF.path)
    Next subF

    For Each File In Fldr.Files
        If LCase(Right(File.path, 4)) = ".pdf" Then
            ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, 2) = Array(File.Name, Replace(File.path, File.Name, ""))
        End If
    Next File

    Set FSO = Nothing
    Set Fldr = Nothing
    Set subF = Nothing
    Set File = Nothing
End Sub

Also, can you add a column which counts the number of versions the filename in column A has. The file name has incrementing values at the end of the name (ie. -1, -2, -3)

 

[Yongle]

Can this code be used if I want to list 2 types of files, and also if I want to list all file.

Filter results in column B to get what you want

Sub ListFiles()
    Application.ScreenUpdating = False
    Dim path As String
    path = "C:\FullPath\ToFolder\"                      'must end with path separator ( \ )
    Cells.Clear
    Cells(1, 1).Resize(, 3).Value = Array("File", "Type", "File Path")
    Call GetFiles(path)
    With Cells(1, 1)
        .Activate
        .AutoFilter
    End With
End Sub

Private Sub GetFiles(ByVal path As String)
    Application.ScreenUpdating = False
    Dim FSO As Object, Fldr As Object, subF As Object, file As Object, extn As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fldr = FSO.GetFolder(path)
    For Each subF In Fldr.SubFolders
        GetFiles (subF.path)
    Next subF

    For Each file In Fldr.Files
        On Error Resume Next
        extn = Right(file.Name, Len(file.Name) - InStrRev(file.Name, "."))
        If Err.Number = 0 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, 3) = Array(file.Name, extn, Replace(file.path, file.Name, ""))
        On Error GoTo 0
    Next file
    
    Set FSO = Nothing
    Set Fldr = Nothing
    Set subF = Nothing
    Set file = Nothing
End Sub

 

[Yongle]

Also, can you add a column which counts the number of versions the filename in column A has. The file name has incrementing values at the end of the name (ie. -1, -2, -3)

Please provide the Excel formula which when placed in D2 and copied down which would return the correct value in every row

If you are unable to determine the correct formula
- start a NEW thread to ask ONLY how to write that formula
- provide sample list of files generated by above code

I will update the code when you provide the formula
thanks

 

[acerlaptop]

Please provide the Excel formula which when placed in D2 and copied down which would return the correct value in every row

If you are unable to determine the correct formula
- start a NEW thread to ask ONLY how to write that formula
- provide sample list of files generated by above code

I will update the code when you provide the formula
thanks

I'm sorry, you can forget about that. But instead, can I have a column that indicates the date created for each listed file?

Thanks

 

[Yongle]

I'm sorry, you can forget about that

why did you ask for this?

But instead, can I have a column that indicates the date created for each listed file?

Amend:

Cells(1, 1).Resize(, 4).Value = Array("File", "Type", "Created", "File Path")
If Err.Number = 0 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, 4) = Array(file.Name, extn, file.DateCreated, Replace(file.path, file.Name, ""))

 

[acerlaptop]

why did you ask for this?


Amend:

Cells(1, 1).Resize(, 4).Value = Array("File", "Type", "Created", "File Path")
If Err.Number = 0 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, 4) = Array(file.Name, extn, file.DateCreated, Replace(file.path, file.Name, ""))

I ask the file count so i'll know if there are multiple versions of 1 file to so I can check which one is valid.

Anyway, where do I put this code on the first code you gave?