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

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

Posted by: admin April 23, 2020 Leave a comment

Questions:

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
How to&Answers:

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