从 PDF 转换后如何修复多余的空白 Excel 文件？答案

【问题标题】：How to fix extra blank Excel files after converting from PDF?从 PDF 转换后如何修复多余的空白 Excel 文件？
【发布时间】：2020-06-08 21:02:49
【问题描述】：

问题是从 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

任何帮助将不胜感激。谢谢！

【问题讨论】：

评论不用于扩展讨论；这个对话是moved to chat。

标签： excel vba pdf

【解决方案1】：

您的问题在于，当您在 Word 中打开 pdf 文件时，会创建一个临时文件。它具有相同的名称，但带有“_$”前缀。如果您修改它以适应循环，您的代码必须按预期工作，如下所示：

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

【讨论】：