Как исправить лишние пустые файлы Excel после конвертации из PDF?

Question

Проблема заключается в том, что после преобразования из PDF в Excel при просмотре для сохранения выходного файла создается дополнительный пустой файл Excel, понятия не имею почему.

Если я преобразовываю 2 PDF-файла, он выводит 2 преобразованных файла Excel и 2 дополнительных чистых документа Excel.

Ниже приведен код:

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

Любая помощь будет принята с благодарностью. Спасибо!

Answer 1

Ваша проблема связана с тем, что при открытии файла PDF в Word создается временный файл. Он имеет то же имя, но с префиксом "_ $". Ваш код должен работать должным образом, если вы измените его, адаптируя l oop следующим образом:

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

Если вы используете точки (.) В именах ваших файлов PDF, мы можем найти другой подход для извлечения его расширение. Если вы поместите в эту папку только файлы PDF, вы можете преобразовать первую строку во что-то более простое:

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