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

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

1、定义一个过程 ReadInvoiceFile

Sub ReadInvoiceFile()
    On Error Resume Next
    Dim FileExtn As String
    Dim iRow As Integer
    InvoiceCode = ""
    InvoiceNo = ""
    SellerName = ""
    SellerTaxID = ""
    Amount = ""
    TaxAmount = ""
    invoiceDate = ""
    ItemName = ""
    BuyerName = ""
    currInvoiceFile = FileSelected
    If currInvoiceFile = "" Then Exit Sub

    FileExtn = GetExtn(currInvoiceFile)
    'Stop
    If FileExtn = ".pdf" Then
        Call ReadPDFInvoiceInfo
    ElseIf FileExtn = ".ofd" Then
        Call ReadOFDInvoiceInfo
    End If
    '发票信息写入工作表
    Sheets("Result").Activate
    With ActiveSheet
        iRow = .UsedRange.Rows.Count + 1
        Cells(iRow, 1) = BuyerName
        Cells(iRow, 2) = invoiceDate
        Cells(iRow, 3) = "'" & InvoiceCode
        Cells(iRow, 4) = "'" & InvoiceNo
        Cells(iRow, 5) = SellerName
        Cells(iRow, 6) = "'" & SellerTaxID
        Cells(iRow, 7) = ItemName
        Cells(iRow, 8) = Amount
        Cells(iRow, 9) = TaxAmount
        Cells(iRow, 10) = CDbl(Amount) + CDbl(TaxAmount)
        .Hyperlinks.Add Anchor:=.Cells(iRow, 11), _
        Address:=currInvoiceFile, _
        TextToDisplay:="打开文件"
    End With
    MsgBox "发票信息读取完毕，请仔细核对！ " & Chr(10) & "若有错误，请手工修改！" & Chr(10) & "空白部分，请手工填写！"
End Sub

代码解析：

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

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

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

tempFolder = "c:\temp\"
If Dir(tempFolder, vbDirectory) = "" Then
    MkDir 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 Next
    Dim fs As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    ' 创建 FileSystemObject
    Set fs = CreateObject("Scripting.FileSystemObject")
    ' 获取目录对象
    Set folder = fs.GetFolder(folderPath)
    ' 遍历目录中的子目录并递归删除
    For Each subFolder In folder.SubFolders
        DeleteDirectory subFolder.Path
    Next subFolder
    ' 删除目录中的文件
    For Each file In folder.Files
        file.Delete
    Next file
    ' 删除目录
    folder.Delete
    ' 释放对象引用
    Set file = Nothing
    Set subFolder = Nothing
    Set folder = Nothing
    Set fs = Nothing
End Sub

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

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

Function GetRARPath()
    Dim rarPath As String
    On 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 = rarPath
    Else
        ' RAR未安装
        GetRARPath = ""
    End If
    On 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位发票号码。

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