How to fix extra blank Excel files after convertin

Question

The problem is that after converting from PDF to Excel, when browsing to save the output file it creates additional blank Excel file, no idea why.

If I convert 2 PDF's it outputs 2 converted Excel files and 2 additional blank Excel documents.

Below is the code:

Option Explicit

Sub PDF_To_Excel()
    Dim setting_sh As Worksheet
    Set setting_sh = ThisWorkbook.Sheets("Setting")
    Dim pdf_path As String
    Dim excel_path As String

    pdf_path = Application.GetOpenFilename(FileFilter:="PDF Files (*.PDF), *.PDF", Title:="Select File To Be Opened")

    excel_path = setting_sh.Range("E12").Value

    Dim objFile As File
    Dim sPath As String
    Dim fso As New FileSystemObject
    Dim fo As Folder
    Dim f As File
    Set objFile = fso.GetFile(pdf_path)
    sPath = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name))
    Set fo = fso.GetFolder(sPath)
    Dim wa As Object
    Dim doc As Object
    Dim wr As Object

    Set wa = CreateObject("word.application")
    'Dim wa As New Word.Application
    wa.Visible = False
    'Dim doc As Word.Document
    Dim nwb As Workbook
    Dim nsh As Worksheet
    'Dim wr As Word.Range

    For Each f In fo.Files
        Set doc = wa.documents.Open(f.Path, False, Format:="PDF Files")
        Set wr = doc.Paragraphs(1).Range
        wr.WholeStory

        Set nwb = Workbooks.Add
        Set nsh = nwb.Sheets(1)

        wr.Copy
        nsh.Activate 'Pastespecial like this needs to use an active sheet (according to https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.pastespecial)
        ActiveSheet.PasteSpecial Format:=1, Link:=False, DisplayAsIcon:=False

        Dim oILS As Shape
        Set oILS = nsh.Shapes(nsh.Shapes.Count)

        With oILS
            .PictureFormat.CropLeft = 5
            .PictureFormat.CropTop = 150
            .PictureFormat.CropRight = 320
            .PictureFormat.CropBottom = 250
        End With
        With oILS
            .LockAspectRatio = True
        '    .Height = 260
        '    .Width = 450
        End With
        nsh.Shapes(nsh.Shapes.Count).Top = Sheets(1).Rows(1).Top
        Dim IntialName As String
        Dim sFileSaveName As Variant
        'IntialName = "Name.xlsx"
        sFileSaveName = Application.GetSaveAsFilename("Name.xlsx", "Excel Files (*.xlsx), *.xlsx")
        If sFileSaveName <> False Then
          nwb.SaveAs sFileSaveName
          doc.Close True
          nwb.Close True
        End If
Next
wa.Quit
End Sub

Any help would be greatly appreciated. Thanks!

Answer 1

Your problem comes from the fact that, when you open your pdf file in Word, a temporary file is created. It has the same name but with "_$" prefix. Your code has to work as expected if you modify it adapting the loop as following:

For Each f In fo.Files
        If Not Split(f.Name, ".")(1) = "pdf" Or _
                    left(f.Name, 2) = "~$" Then
        Else
            'your existing code follows here....
            '...
        End If
Next

If you use dots (.) in your pdf file names, we can find a different approach to extract its extension. If you drop in that folder only pdf files, you can transform the first line in something simpler:

If left(f.Name, 2) = "~$" Then