VB code to list PDF files from a specific folder into a MS-Excel sheet

Question

Hi,

I am trying to create a MS-Excel macro to list all PDF file names in a given folder on an MS-Excel sheet.  I got the below VB code to do that for me, however I need a conditional step. 

What I am trying to achieve is - if the folder does not contain any PDF file, a message box should appear saying "No PDF files found".   I don't know how to incorporate to this code.

Can anyone help me on this?

Thanks for your help,

Manuvendran

Sub ListPDFFiles()

    Dim objFSO As Object

    Dim objFolder As Object

    Dim objFile As Object

    Dim ws As Worksheet

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set ws = ActiveSheet

    Dim folderpath

    folderpath = InputBox("Enter Folder Path", "Folder Path")

     'Get the folder object associated with the directory

    Set objFolder = objFSO.GetFolder(folderpath)

    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

Answer 1

Hi,

Sorry, the IF loop has to come out of the For Next loop.  Try this

Sub ListPDFFiles()

    Dim objFSO As Object

    Dim objFolder As Object

    Dim objFile As Object

    Dim ws As Worksheet

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set ws = ActiveSheet

    Dim folderpath

    folderpath = InputBox("Enter Folder Path", "Folder Path")

     'Get the folder object associated with the directory

    Set objFolder = objFSO.GetFolder(folderpath)

    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", "")

        z=z+1

        End If

      Next

      If z=0 then

             Msgbox "No PDF Files found"

        Endif 

      'Clean up!

    Set objFolder = Nothing

    Set objFile = Nothing

    Set objFSO = Nothing

End Sub

Answer 2

Try code like the following:

Sub ListPDF()

    Dim R As Range

    Dim N As Long

    Dim FolderName As String

    Dim FileName As String

    Dim SaveDir As String

    SaveDir = CurDir

    Set R = Worksheets("Sheet1").Range("A1") '<<< #1 change start list cell

    FolderName = "G:\MathNET" '<<< #2 change folder name

    If Dir(FolderName, vbDirectory) = vbNullString Then

        MsgBox "Folder '" & FolderName & "' does not exist."

        Exit Sub

    End If

    ChDrive FolderName

    ChDir FolderName

    FileName = Dir("*.pdf")

    Do Until FileName = vbNullString

        N = N + 1

        R.Value = FileName

        Set R = R(2, 1)

        FileName = Dir()

    Loop

    If N = 0 Then

        MsgBox "No PDFs found"

    Else

        MsgBox Format(N, "#,##0") & " PDFs found"

    End If

    ChDrive SaveDir

    ChDir SaveDir

End Sub

Change item '<<< #1 to the range where the listing should begin.  Change '<<< #2 to the full folder path name.

Answer 3

You are welcome.

Answer 4

Hi,

Try this

Sub ListPDFFiles()

    Dim objFSO As Object

    Dim objFolder As Object

    Dim objFile As Object

    Dim ws As Worksheet

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set ws = ActiveSheet

    Dim folderpath

    folderpath = InputBox("Enter Folder Path", "Folder Path")

     'Get the folder object associated with the directory

    Set objFolder = objFSO.GetFolder(folderpath)

    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", "")

        z=z+1

        End If

        If z=0 then

             Msgbox "No PDF Files found"

        Endif 

     Next

     'Clean up!

    Set objFolder = Nothing

    Set objFile = Nothing

    Set objFSO = Nothing

End Sub

Answer 5

Hi Ashish,

Thanks for the reply.

Even though this code works, I had to click 'OK' button in the message box a lot of times to get rid of it.

Please advise.

Thanks,

Manuvendran