从PDF中提取表格（到Excel），最好使用VBA

Question

我正在尝试使用VBA从PDF文件中提取表格并将其导出到Excel。如果一切按预期进行，它应该是完全自动的。问题在于表格不是标准化的。

目前我已经完成了以下工作：

1. VBA（Excel）运行XPDF，并将当前文件夹中找到的所有.pdf文件转换为文本文件。 2. 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列），有些表格之间的空格更多，而有些不包括某些行（例如资本资产净额）。

我正在考虑做类似于这样的事情，但不确定如何在VBA中进行。

1. 查找用户定义的字符串。例如："Table 1: Years' Return."
2. a. 下一行找到年份；如果有两个年份，输出需要三列（标题+2个年份），如果有三个年份，则需要四列（标题+3个年份）等
   b. 创建标题列和每个年份的列。
3. 到达行末时，转到下一行
4. a. 读取文本->输出到第1列。
   b. 将空格识别为第2列的开始。读取数字->输出到第2列。
   c.（如果列=3）将空格识别为第3列的开始。读取数字->输出到第3列。
   d.（如果列=4）将空格识别为第4列的开始。读取数字->输出到第4列。
5. 每行循环4次。
6. 下一行不包含任何数字-结束表格。（可能是最简单的，只需一个用户定义的数字，在15个字符后没有数字？结束表格）

我第一个版本的基础是 Pdf to Excel，但是在网上阅读后，人们不推荐使用OpenFile，而是推荐使用FileSystemObject（尽管它似乎慢得多）。

有没有任何指引可以让我开始进行第二步？

- user2102869

---

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

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

请提供要翻译的英文文本，我可以将其翻译成中文。从PDF获取样本文本会非常有帮助！ - Peter L.

我怀疑你通常无法仅基于文本提取来解析表格。你更可能需要一些提取带有定位信息的文本的库。如果表格中有一些空条目或者是由某些PDF创建软件创建的PDF，你的算法很可能会失败。 - mkl

Answer 1

你有多种方法来解析文本文件，具体取决于它的复杂程度可能会导致你倾向于一种或另一种方式。我开始这个项目，但它有点失控了...请享用。

基于您提供的示例和其他评论，我注意到以下内容。其中一些对于简单的文件可能很有效，但是对于更大更复杂的文件可能会变得难以处理。此外，可能有更高效的方法或技巧可用于我在此处使用的方法，但这绝对可以让您开始并实现所需的结果。希望这与提供的代码相结合后能够让您理解。

• 您可以使用布尔值来帮助您确定文本文件中的“部分”。例如，在当前行上使用 InStr 来确定是否在表格中，通过查找文本“Table”，一旦确定在文件的“Table”部分，则开始查找“Assets”部分等。
• 您可以使用一些方法来确定您拥有的年数（或列数）。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 stackoverflow 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

- CuberChase

---

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

我认为我的编译错误是因为.pdf文件太大了。但是没有任何部分超过10行，所以不确定它如何达到99的限制。iNoColumns似乎也无法保留其数字..但再次我认为这更多是由于我的实现而不是其他原因。 - user2102869

很高兴能帮到你 :) 像iColumns(1)这样的问题是你在阅读更多文件时会逐渐解决的小问题。似乎当为新表重新定义iColumns时，它没有任何列，所以iColumns(1)会失败。你应该加入一个检查来处理这个问题。我不认为这与你的PDF大小有关，它应该能够处理32767行（一个Int的大小）。我还建议将你的子程序分解一下。将读取文本文件的子程序拆分出来。然后你可以单独转换几个PDF并测试结果。 - CuberChase

感谢您额外提供的评论和建议。我在上面使用了错误的模板文件（文本文件示例），但现在逻辑更加清晰，我应该能够得出正确的结果。再次感谢！ - user2102869

Answer 2

另一种我成功使用的方法是使用VBA将文件转换为.doc或.docx文件，然后从Word文件中搜索并提取表格。它们可以轻松地提取到Excel工作表中。转换似乎很好地处理了表格。但请注意，它是基于页面的，因此跨页的表格最终会成为Word文档中的单独表格。

- Morris Lancaster

---

如果将其转换为Word文件并提取成功，这可能会对其他人有所帮助。您能否编辑此答案以包括您在此情况下使用的子例程和/或函数？目前，具有类似问题的用户将无法测试您的解决方案，并且已经存在适用于OP的解决方案。 - jessi

Answer 3

由于PasteBin已被删除，我无法检查示例数据。根据问题描述中我所能了解的内容，使用正则表达式似乎可以更轻松地解析数据。

为FileSystemObject添加Scripting Runtime scrrun.dll引用。
为RegExp对象添加Microsoft VBScript Regular Expressions 5.5库引用。

使用以下代码实例化RegEx对象： Dim objRE As New RegExp

将Pattern属性设置为"(\bd{4}\b){1,3}"。 上述模式应匹配包含以下字符串的行： 2010 2010 2011 2010 2011 2012

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

将Global属性设置为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+\.\d{2}\b){1,3}"
Next i

这只是我处理这个挑战的大致思路概述。我希望在这段代码概述中有些许对你有所帮助的内容。

- Cyraneau de Beargerac