VBA学习(75)：电子发票管理小助手/电子发票信息读取

news/2024/9/18 14:10:35/ 标签: excel, VBA

“电子发票管理助手”设计过程与思路

1、定义一个过程 ReadInvoiceFile

Sub ReadInvoiceFile()On Error Resume NextDim FileExtn As StringDim iRow As IntegerInvoiceCode = ""InvoiceNo = ""SellerName = ""SellerTaxID = ""Amount = ""TaxAmount = ""invoiceDate = ""ItemName = ""BuyerName = ""currInvoiceFile = FileSelectedIf currInvoiceFile = "" Then Exit SubFileExtn = GetExtn(currInvoiceFile)'StopIf FileExtn = ".pdf" ThenCall ReadPDFInvoiceInfoElseIf FileExtn = ".ofd" ThenCall ReadOFDInvoiceInfoEnd If'发票信息写入工作表Sheets("Result").ActivateWith ActiveSheetiRow = .UsedRange.Rows.Count + 1Cells(iRow, 1) = BuyerNameCells(iRow, 2) = invoiceDateCells(iRow, 3) = "'" & InvoiceCodeCells(iRow, 4) = "'" & InvoiceNoCells(iRow, 5) = SellerNameCells(iRow, 6) = "'" & SellerTaxIDCells(iRow, 7) = ItemNameCells(iRow, 8) = AmountCells(iRow, 9) = TaxAmountCells(iRow, 10) = CDbl(Amount) + CDbl(TaxAmount).Hyperlinks.Add Anchor:=.Cells(iRow, 11), _Address:=currInvoiceFile, _TextToDisplay:="打开文件"End WithMsgBox "发票信息读取完毕，请仔细核对！ " & Chr(10) & "若有错误，请手工修改！" & Chr(10) & "空白部分，请手工填写！"
End Sub

代码解析：

先把一些公共变量值清空，然后选择文件，根据文件后缀判断，是PDF的，我们运行ReadPDFInvoiceInfo过程，是OFD的，我们运行ReadOFDInvoiceInfo过程，这两个过程都是用来读取发票信息的，读取到的信息存到变量中，完成后，回到本过程再把发票信息写入工作表，并添加发票文件链接。

2、读取PDF文件过程ReadPDFInvoiceInfo，代码较多，我贴到第二条文章。

（1）设置临时文件夹c:\temp\，如果没有则创建。

tempFolder = "c:\temp\"
If Dir(tempFolder, vbDirectory) = "" ThenMkDir tempFolder
End If

（2）创建 Acrobat 应用程序对象，打开PDF发票文件，转存为WORD文件。

'创建 Acrobat 应用程序对象
Set acrobatApp = CreateObject("AcroExch.App")
'创建 Acrobat AVDoc 对象
Set AcrobatAVDoc = CreateObject("AcroExch.AVDoc")
'打开选择的 PDF 文件
AcrobatAVDoc.Open currInvoiceFile, ""
acrobatApp.Hide
Set AcrobatPDDoc = AcrobatAVDoc.GetPDDoc
Set jsObj = AcrobatPDDoc.getjsobject
'创建 Word 应用程序对象
Set WordApp = CreateObject("Word.Application")
'关闭安全提示
WordApp.Application.AutomationSecurity = msoAutomationSecurityForceDisable
'将 PDF 转换为 Word
WordFilePath = tempFolder & Format(Time, "hhmmss") & ".docx"
jsObj.SaveAs WordFilePath, "com.adobe.acrobat.docx"
'关闭和清理 Acrobat
AcrobatAVDoc.Close 1
acrobatApp.Exit

（3）打开WORD文件，读取信息到变量wordContent，然后通过正则表达式提取相应的发票关键字信息存入变量。

（4）读取完成后，删除临时文件夹。这里建立了一个删除文件夹的过程，看看代码就知道是ChatGPT生成的，基本没改。

Sub DeleteDirectory(ByVal folderPath As String)On Error Resume NextDim fs As ObjectDim folder As ObjectDim subFolder As ObjectDim file As Object' 创建 FileSystemObjectSet fs = CreateObject("Scripting.FileSystemObject")' 获取目录对象Set folder = fs.GetFolder(folderPath)' 遍历目录中的子目录并递归删除For Each subFolder In folder.SubFoldersDeleteDirectory subFolder.PathNext subFolder' 删除目录中的文件For Each file In folder.Filesfile.DeleteNext file' 删除目录folder.Delete' 释放对象引用Set file = NothingSet subFolder = NothingSet folder = NothingSet fs = Nothing
End Sub

3、读取OFD文件过程ReadOFDInvoiceInfo，代码也不少，同样我贴到第二条文章。

（1）检查有没有RAR压缩文件，有就取得其安装路径，没有就退出程序。这里定义了一个自定义函数GetRARPath，也是ChatGPT贡献的

Function GetRARPath()Dim rarPath As StringOn Error Resume Next' 打开WinRAR的注册表项rarPath = CreateObject("WScript.Shell").RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRAR.exe\")If Err.Number = 0 Then' 获取WinRAR的安装路径GetRARPath = rarPathElse' RAR未安装GetRARPath = ""End IfOn Error GoTo 0
End Function

（2）把OFD文件解压到临时文件夹下，这里通过shell函数执行RAR解压命令，由于解压需要点时间，所以用了个Sleep函数暂停1秒，不然没完全解压就执行后面的代码会报错，虽然后面Do Until~Loop也是起等待的作用，在原来只有一种发票格式的情况下可行，后来增加了一种发票就不太行了，有时会报错，这里以后再优化：

destFolder = tempFolder & Format(Time, "hhmmss") & "\"
rarCmd = rarPath & " X " & currInvoiceFile & " " & destFolder
Result = shell(rarCmd, vbHide)
Sleep 1000 ' Delay for 2 seconds (2000 milliseconds)
'等待解压完成
Do Until Dir(destFolder & "Doc_0\Attachs\original_invoice.xml") <> "" _Or Dir(destFolder & "Doc_0\Pages\Page_0\Content.xml") <> ""DoEvents
Loop

（3）读取发票信息

NewDOMD.Load destFolder & "Doc_0\Attachs\original_invoice.xml"Set xmld = NewDOMD.DocumentElement.SelectSingleNode("//eInvoice")Set SelectedNode = xmld.SelectSingleNode("//fp:InvoiceCode")InvoiceCode = SelectedNode.Text......NewDOMD.Load destFolder & "Doc_0\Pages\Page_0\Content.xml"
Set xmld = NewDOMD.DocumentElement.SelectSingleNode("//ofd:Page")
Set SelectedNode = xmld.SelectSingleNode("//ofd:TextObject[@ID='6922']/ofd:TextCode")
InvoiceCode = Left(SelectedNode.Text, 12)
InvoiceNo = Right(SelectedNode.Text, 8)

代码解析：

（A） NewDOMD.Load加载XML文件

（B）Set xmld取得一个节点

（C）Set SelectedNode选中一个具体的节点

（D）InvoiceCode = SelectedNode.Text ，把节点TEXT赋值给变量。

（E）开头是旧式的电子发票，有密码区的，后面的最近的数电发票，两者的结构是不一样的，有兴趣的朋友可以找来这样的发票解压后分析。新式发票没有发票代码，发票号码是20位，这里我们还是把它处理成12位发票代码和8位发票号码。

其他一些过程什么的就不说了，上面的示例代码仅为部分代码，并且后续可能会修改，感兴趣的朋友可以参看第二条文章或者索取示例文件查看。