从pdf中提取表格(excel),pref。 w / vba

我想用vba从pdf文件中提取表格,并将它们导出为ex​​cel。 如果一切按其应有的方式进行,应该全部自动进行。 问题是表格不规范。

这是我迄今为止。

  1. VBA(Excel)运行XPDF ,并将当前文件夹中find的所有.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 

这一切都很好。 但现在我正在从文本文件中提取表的问题。 我想要做的是VBAfind一个string,例如“Year's Income”,然后将数据输出到列中。 (在表格结束之前)

第一部分不是很困难(find一定的string),但是我将如何去做第二部分。 文本文件看起来像这个Pastebin 。 问题是文本不规范。 因此,例如一些表格有3年的列(2010 2011 2012)和一些只有两个(或1),有些表格在列之间有更多的空间,有些不包括某些行(如资本资产,净额)。

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

  1. 查找用户定义的string 例如。 “表1:几年的回报。”
  2. 一个。 下一行find年份; 如果有两个,我们将需要三列输出(标题+,两年),如果有三个,我们将需要四个(标题+,三年)..等
    湾 为每年创build标题栏+列。
  3. 到达行尾时,转到下一行
  4. 一个。 阅读文本 – >输出到第1列。
    湾 识别空格(空格> 3?)作为第2列的开始。读取数字 – >输出到第2列。
    C。 (如果列= 3)将空格识别为列3的开始。读取编号 – >输出到列3。
    d。 (如果列= 4)将空格识别为列4的开始。读取数字 – >输出到列4。
  5. 每一行,循环4。
  6. 下一行不包括任何数字 – 结束表。 (可能只是一个用户定义的号码,15个字符后没有数字?结束表)

我基于我的第一个版本的PDF来优秀 ,但在线阅读的人不build议OpenFile ,而是FileSystemObject (即使它看起来慢得多)。

任何指针让我开始,主要是在第2步?

你有很多方法来parsing一个文本文件,并根据它有多复杂可能会导致你倾向于这样或那样。 我开始了这一点,它有点失控…享受。

根据您提供的样本和其他意见,我注意到以下内容。 其中一些可能适用于简单的文件,但可能会更复杂的文件更大的笨拙。 此外,可能会有更有效的方法或技巧,以我在这里使用,但这一定会让你达到预期的结果。 希望这与所提供的代码相结合:

  • 您可以使用布尔值来帮助您确定所在文本文件的“部分”。即,使用当前行上的InStr ,通过查找“Table”文本来确定您是否在表格中,然后一旦知道您处于文件的“表”部分开始寻找“资产”部分等
  • 您可以使用几种方法来确定您拥有的年数(或列)。 Splitfunction和循环将完成这项工作。
  • 如果你的文件总是有固定的格式,即使只在某些部分,你也可以利用这个。 例如,如果你知道你的文件行总是在它们前面有一个美元符号,那么你知道这将定义列的宽度,你可以在随后的文本行上使用它。

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

  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 

由于PasteBin已被删除,我无法检查示例数据。 根据我可以从问题描述中收集的信息,在我看来,使用正则expression式会使数据parsing变得更容易。

为FileSystemObject添加对Scripting Runtime scrrun.dll的引用。
添加对Microsoft VBScript正则expression式5.5的引用。 RegExp对象库。

使用Dim objRE作为新的RegExp实例化RegEx对象

将Pattern属性设置为“(\ bd {4} \ b){1,3}”上述模式应该在包含以下string的行上匹配:2010 2010 2011 2010 2011 2012

年份string之间的空格数目是不相关的,只要至less有一个(因为我们不期望遇到像201020112012这样的string)

将全局属性设置为True

捕获的组将在RegEx对象objRE的Execute方法返回的MatchCollection的各个Match对象中find。 所以申报适当的对象:

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

假设你已经build立了一个FileSystemObject对象并且正在扫描这个文本文件,把每行读入一个variablesstrLine中

首先testing以查看当前行是否包含所寻找的模式:

 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) eg 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 

这只是我如何处理这个挑战的一个粗略概要。 我希望这个代码大纲中有一些东西对你有帮助。