Have PDFs in folders. Need to record the names and locations in Excel

Question

Don't see any questions similar to what I am looking for.

I have about 20k+ PDFs stored in various locations on my C drive. I don't have a complete list of what is available or when they were created.

What I am looking to do is find the names, size and dates that the file was created. These would need to be recorded in an Excel spreadsheet

Note: Some of the PDFs are buried about 6 or 7 folders deep, while some are only 1 folder deep.

Can anybody suggest a way of automatically do it?

I have tried using this code*:

Sub ListAllFiles()
    Dim fs As FileSearch, ws As Worksheet, i As Long
    Dim r As Long
    Set fs = Application.FileSearch
    With fs
        .SearchSubFolders = True '
        .FileType = msoFileTypeAllFiles 'can modify to just Excel files eg with msoFileTypeExcelWorkbooks
        .LookIn = "H:\My Desktop"
        If .Execute > 0 Then
            Set ws = Worksheets.Add
            r = 1
            For i = 1 To .FoundFiles.Count
                If Right(.FoundFiles(i), 3) = ".pdf" Or Right(.FoundFiles(i), 3) = ".tif" Then
                    ws.Cells(r, 1) = .FoundFiles(i)
                    r = r + 1
                End If
            Next
        Else
             MsgBox "No files found"
        End If
    End With
End Sub

However, this seems to return an issue in the 4th line - application.filesearch

I have also tried this*, which works well, but doesn't go into the folders:

Sub ListAllFile()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add

     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("H:\My Desktop")
    ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & " are:"

     'Loop through the Files collection
    For Each objFile In objFolder.Files
        If UCase$(Right$(objFile.Name, 4)) = ".PDF" Then
            ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = Replace$(UCase$(objFile.Name), ".PDF", "")
        End If

    Next

     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing

End Sub

Any help would be gratefully appreciated.

these are codes that I found on the net

This question gets asked all the time in some variety. http://stackoverflow.com/questions/20219362/excel-vba-to-list-files-in-folder-and-subfolder-with-path-to-txt-file and http://stackoverflow.com/questions/9827715/get-list-of-subdirs-in-vba — Byron Wall, Jun 29 '15 at 16:11

paul bica · Accepted Answer · 2015-06-30T06:05:08.663

Maybe this will help

The main function imports the output from the Dos command: Dir C:\*.pdf /S | Find "pdf"

Public Sub listFileTypes(Optional ByVal root As String = "C:\*.", _
                         Optional ByVal ext As String = "pdf")

    Const MAX_SIZE  As Long = 17    'max space reserved for file sizes

    Dim i As Long, maxRow As Long, maxCol As Long, fInfo As String, ws As Worksheet
    Dim arrLines As Variant, s As String, pat As String, midSp As Long

    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    ws.Cells.Delete
    s = CreateObject("WScript.Shell").Exec( _
            "%comspec% /C Dir """ & root & ext & """  /S | Find """ & ext & """" _
        ).STDOut.ReadAll
    'Application.Wait Now + TimeValue("0:00:01")    'built-in replacement for "Sleep"
    If Len(s) > 0 Then
        For i = MAX_SIZE To 2 Step -1
            s = Replace(s, Space(i), vbTab)         'replace space sets with tabs
        Next
        arrLines = Split(s, vbCrLf)
        maxRow = UBound(arrLines, 1)
        With ws
            .Cells(1, 1).Value2 = root & ext
            For i = 2 To maxRow + 2
                If Len(arrLines(i - 2)) > 0 Then
                    maxCol = UBound(Split(arrLines(i - 2), vbTab))
                    If maxCol > 0 Then
                        .Range( _
                                .Cells(i, 1), _
                                .Cells(i, maxCol + 1)) = Split(arrLines(i - 2), vbTab)
                        'split file size from name
                        fInfo = .Cells(i, maxCol + 1).Value2
                        midSp = InStr(1, fInfo, " ")
                        .Cells(i, maxCol + 1).Value2 = Mid(fInfo, 1, midSp)
                        .Cells(i, maxCol + 2).Value2 = Mid(fInfo, midSp)
                    End If
                End If
            Next
            .UsedRange.Columns.AutoFit
            For i = 1 To 3
                .Columns(i).EntireColumn.ColumnWidth = .Columns(i).ColumnWidth + 5
            Next
        End With
    End If
    Application.ScreenUpdating = True
End Sub

This is how you can call it:

Public Sub testFileTypes()

    listFileTypes "C:\*", "pdf"     'or: listFileTypes "C:\Temp\*", "pdf"

End Sub

It might take a while if you have so many, but it will generate a list similar to this (per drive)

enter image description here

Love that code Paul, the only thing is the column width loop at the end, can you not replace it with Range("A1:C1").EntireColumn.ColumnWidth = Range("A1:C1").EntireColumn.ColumnWidth + 5 — Dan Donoghue, Jun 30 '15 at 05:44
Thanks @Dan - I thought about it but wasn't sure if it will get individual widths properly; but I'll definitely try it and update it if it works!! — paul bica, Jun 30 '15 at 05:50
@Dan - it would have been a great idea: I tried yours and this:`.Columns("A:C").ColumnWidth = .Columns("A:C").ColumnWidth + 3` but doesn't do it... — paul bica, Jun 30 '15 at 05:54

Have PDFs in folders. Need to record the names and locations in Excel

1 Answers1