从 pdf 中提取表格（到 excel），pref。带 vba

Posted 2023-02-24

【中文标题】从 pdf 中提取表格（到 excel），pref。带 vba

【英文标题】：Extract tables from pdf (to excel), pref. w/ vba

【发布时间】：2013-02-09 07:49:42

【问题描述】：

我正在尝试使用 vba 从 pdf 文件中提取表格并将它们导出到 excel。如果一切都按应有的方式进行，它应该是自动的。问题是表格不规范。

这是我目前所拥有的。

VBA (Excel) 运行 XPDF，并将在当前文件夹中找到的所有 .pdf 文件转换为文本文件。 VBA (Excel) 逐行读取每个文本文件。

还有代码：

With New Scripting.FileSystemObject
With .OpenTextFile(strFileName, 1, False, 0)

    If Not .AtEndOfStream Then .SkipLine
    Do Until .AtEndOfStream
        //do something
    Loop
End With
End With

这一切都很好。但是现在我要解决从文本文件中提取表格的问题。 我正在尝试做的是 VBA 来查找字符串，例如“年收入”，然后将数据输出到列中。 （直到表格结束。）

第一部分不是很难（找到某个字符串），但是我将如何进行第二部分。文本文件看起来像this Pastebin。问题是文本没有标准化。因此，例如，有些表有 3 年的列（2010 2011 2012），有些只有两个（或 1 个），有些表在列之间有更多空格，有些不包括某些行（例如 Capital Asset，net）。

我正在考虑做这样的事情，但不知道如何在 VBA 中进行。

查找用户定义的字符串。例如。 “表一：年复一年。” 一种。下一行查找年份；如果有两个，我们将需要输出三列（标题 +，2x 年），如果有三个，我们将需要四个（标题 +，3x 年）.. 等等 湾。为每年创建标题列+列。 到达行尾时，转到下一行 一种。读取文本 -> 输出到第 1 列。 湾。将空格（空格 > 3？）识别为第 2 列的开头。读取数字 -> 输出到第 2 列。 C。 （如果 column = 3）将空格识别为第 3 列的开头。读取数字 -> 输出到第 3 列。 d。 （如果 column = 4）将空格识别为第 4 列的开头。读取数字 -> 输出到第 4 列。 每行，循环 4 个。 下一行不包含任何数字 - 结束表。 （可能最简单的只是用户定义的数字，15 个字符后没有数字？结束表）

我的第一个版本基于Pdf to excel，但在线阅读的人不推荐OpenFile，而是推荐FileSystemObject（尽管它看起来要慢很多）。

任何让我开始的指针，主要是第 2 步？

【问题讨论】：

如果您想稍后在问题中添加资源或一些细节，您可以编辑问题并将其附加到问题中。

谢谢，但我不能添加超过 2 个链接。感谢您的编辑！

从 PDF 获得的示例文本将非常有帮助！

我怀疑您通常只能根据文本提取来解析表格。您更有可能需要一些库来提取带有定位信息的文本。如果表格中有一些空条目，以及某些 PDF 创建软件创建的 pdf，您的算法很可能会失败。

【参考方案1】：

您有多种方法来剖析文本文件，具体取决于它的复杂程度，您可能会倾向于一种或另一种方式。我开始了这个，它有点失控......享受。

根据您提供的示例和其他 cmets，我注意到以下内容。其中一些可能适用于简单文件，但对于更大更复杂的文件可能会变得笨拙。此外，我在这里使用的方法或技巧可能会稍微有效一些，但这肯定会让你达到预期的结果。希望这与提供的代码一起有意义：

您可以使用布尔值来帮助您确定您所在的文本文件的“部分”。即在当前行使用InStr 通过查找文本“表格”确定您在表格中，然后 一旦你知道你在文件开始的“表格”部分 寻找“资产”部分等 您可以使用几种方法来确定您拥有的年数（或列数）。 Split 函数和一个循环就可以了 工作。 如果您的文件始终具有固定格式，即使仅在某些部分，您也可以利用这一点。例如，如果您知道您的 文件行前面总是有一个美元符号，然后 你知道这将定义列宽，你可以使用它 随后的文本行。

以下代码将从文本文件中提取资产详细信息，您可以对其进行修改以提取其他部分。它应该处理多行。希望我已经足够评论了。看看，如果需要进一步帮助，我会进行编辑。

 Sub ReadInTextFile()
    Dim fs As Scripting.FileSystemObject, fsFile As Scripting.TextStream
    Dim sFileName As String, sLine As String, vYears As Variant
    Dim iNoColumns As Integer, ii As Integer, iCount As Integer
    Dim bIsTable As Boolean, bIsAssets As Boolean, bIsLiabilities As Boolean, bIsNetAssets As Boolean

    Set fs = CreateObject("Scripting.FileSystemObject")
    sFileName = "G:\Sample.txt"
    Set fsFile = fs.OpenTextFile(sFileName, 1, False)

    'Loop through the file as you've already done
    Do While fsFile.AtEndOfStream <> True
        'Determine flag positions in text file
        sLine = fsFile.Readline

        Debug.Print VBA.Len(sLine)

        'Always skip empty lines (including single spaceS)
        If VBA.Len(sLine) > 1 Then

            'We've found a new table so we can reset the booleans
            If VBA.InStr(1, sLine, "Table") > 0 Then
                bIsTable = True
                bIsAssets = False
                bIsNetAssets = False
                bIsLiabilities = False
                iNoColumns = 0
            End If

            'Perhaps you want to also have some sort of way to designate that a table has finished.  Like so
            If VBA.Instr(1, sLine, "Some text that designates the end of the table") Then
                bIsTable = False
            End If 

            'If we're in the table section then we want to read in the data
            If bIsTable Then
                'Check for your different sections.  You could make this constant if your text file allowed it.
                If VBA.InStr(1, sLine, "Assets") > 0 And VBA.InStr(1, sLine, "Net") = 0 Then bIsAssets = True: bIsLiabilities = False: bIsNetAssets = False
                If VBA.InStr(1, sLine, "Liabilities") > 0 Then bIsAssets = False: bIsLiabilities = True: bIsNetAssets = False
                If VBA.InStr(1, sLine, "Net Assests") > 0 Then bIsAssets = True: bIsLiabilities = False: bIsNetAssets = True

                'If we haven't triggered any of these booleans then we're at the column headings
                If Not bIsAssets And Not bIsLiabilities And Not bIsNetAssets And VBA.InStr(1, sLine, "Table") = 0 Then
                    'Trim the current line to remove leading and trailing spaces then use the split function to determine the number of years
                    vYears = VBA.Split(VBA.Trim$(sLine), " ")
                    For ii = LBound(vYears) To UBound(vYears)
                        If VBA.Len(vYears(ii)) > 0 Then iNoColumns = iNoColumns + 1
                    Next ii

                    'Now we can redefine some variables to hold the information (you'll want to redim after you've collected the info)
                    ReDim sAssets(1 To iNoColumns + 1, 1 To 100) As String
                    ReDim iColumns(1 To iNoColumns) As Integer
                Else
                    If bIsAssets Then
                        'Skip the heading line
                        If Not VBA.Trim$(sLine) = "Assets" Then
                            'Increment the counter
                            iCount = iCount + 1

                            'If iCount reaches it's limit you'll have to redim preseve you sAssets array (I'll leave this to you)
                            If iCount > 99 Then
                                'You'll find other posts on *** to do this
                            End If

                            'This will happen on the first row, it'll happen everytime you
                            'hit a $ sign but you could code to only do so the first time
                            If VBA.InStr(1, sLine, "$") > 0 Then
                                iColumns(1) = VBA.InStr(1, sLine, "$")
                                For ii = 2 To iNoColumns
                                    'We need to start at the next character across
                                    iColumns(ii) = VBA.InStr(iColumns(ii - 1) + 1, sLine, "$")
                                Next ii
                            End If

                            'The first part (the name) is simply up to the $ sign (trimmed of spaces)
                            sAssets(1, iCount) = VBA.Trim$(VBA.Mid$(sLine, 1, iColumns(1) - 1))
                            For ii = 2 To iNoColumns
                                'Then we can loop around for the rest
                                sAssets(ii, iCount) = VBA.Trim$(VBA.Mid$(sLine, iColumns(ii) + 1, iColumns(ii) - iColumns(ii - 1)))
                            Next ii

                            'Now do the last column
                            If VBA.Len(sLine) > iColumns(iNoColumns) Then
                                sAssets(iNoColumns + 1, iCount) = VBA.Trim$(VBA.Right$(sLine, VBA.Len(sLine) - iColumns(iNoColumns)))
                            End If
                        Else
                            'Reset the counter
                            iCount = 0
                        End If
                    End If
                End If

            End If
        End If
    Loop

    'Clean up
    fsFile.Close
    Set fsFile = Nothing
    Set fs = Nothing
End Sub

【讨论】：

哇！非常感谢，这比我要求的要多。谢谢！我收到编译错误； this pastebin 有完整的代码。下标超出范围'iColumns(1) = VBA.InStr(1, sLine, "$")'

我认为我的编译错误是因为 .pdf 文件太大。但是没有一个部分包含超过 10 行，所以不确定它如何达到 99 的限制。 iNoColumns 似乎也没有保留它的号码。但我再次认为这更多是由于我的实施而不是其他任何事情。

很高兴它有帮助 :) 您遇到的像 iColumns(1) 这样的问题是您在阅读更多文件时会细化的小问题。似乎当 iColumns 为新表 Redim'd 时，它没有任何列，因此 iColumns(1) 失败。你想检查一下。我认为这与您的 pdf 的大小无关，它应该能够处理 32767 行（Int 的大小）。我还建议你把你的潜艇拆开一点。我会拆分在文本文件中读取的子。然后，您可以转换几个 PDF 并分别测试结果。

感谢额外的 cmets 和建议。我在上面使用了错误的模板文件（文本文件示例），但现在逻辑更有意义，我应该能够推导出它。再次感谢！

【参考方案2】：

我无法检查示例数据，因为 PasteBin 已被删除。根据我从问题描述中收集到的信息，在我看来，使用正则表达式会使解析数据变得更加容易。

为 FileSystemObject 添加对脚本运行时 scrrun.dll 的引用。 添加对 Microsoft VBScript 正则表达式 5.5 的引用。 RegExp 对象的库。

实例化一个 RegEx 对象 将 objRE 调暗为新的正则表达式

将 Pattern 属性设置为“(\bd4\b)1,3” 上面的模式应该匹配包含如下字符串的行： 2010 2010 2011 2010 2011 2012

年份字符串之间的空格数无关紧要，只要至少有一个（因为我们不希望遇到像 201020112012 这样的字符串）

将全局属性设置为 True

将在 RegEx 对象 objRE 的 Execute 方法返回的 MatchCollection 中的各个 Match 对象中找到捕获的组。所以声明适当的对象：

Dim objMatches as MatchCollection
Dim objMatch as Match
Dim intMatchCount 'tells you how many year strings were found, if any

假设你已经设置了一个 FileSystemObject 对象并且正在扫描文本文件，将每一行读入一个变量 strLine

首先测试当前行是否包含寻找的模式：

If objRE.Test(strLine) Then
  'do something
Else
  'skip over this line
End If

Set objMatches = objRe.Execute(strLine)
intMatchCount = objMatches.Count

For i = 0 To intMatchCount - 1
   'processing code such as writing the years as column headings in Excel
    Set objMatch = objMatches(i)
    e.g. ActiveCell.Value = objMatch.Value
   'subsequent lines beneath the line containing the year strings should
   'have the amounts, which may be captured in a similar fashion using an
   'additional RegExp object and a Pattern such as "(\b\d+\b)1,3" for
   'whole numbers or "(\b\d+\.\d+\b)1,3" for floats. For currency, you
   'can use "(\b\$\d+\.\d2\b)1,3"
Next i

这只是我将如何应对这一挑战的粗略概述。我希望这个代码大纲中的某些内容对您有所帮助。

【参考方案3】：

我取得了一些成功的另一种方法是使用 VBA 转换为 .doc 或 .docx 文件，然后搜索并从 Word 文件中提取表格。它们可以很容易地提取到 Excel 工作表中。转换似乎很好地处理了表格。但请注意，它是逐页工作的，因此延伸到一页上的表格最终会在 word doc 中作为单独的表格。

【讨论】：

如果转换为 Word 文件并解压对您来说效果很好，它可能对其他人有所帮助。您可以编辑此答案以包含您在这种情况下使用的子例程和/或函数吗？就目前而言，与 OP 有类似问题的用户将无法测试您的解决方案，并且存在适用于 OP 的现有解决方案。