VAT验证代码新增网页转PDF保存功能遇64位兼容问题求助

我来帮你搞定这两个问题——把PDF保存功能整合到现有VAT验证代码里，同时修复64位Office的兼容性报错。先理清楚你的需求和遇到的问题：

你的需求与问题 #

• 现有VBA代码能正常验证VAT号码，现在要每验证一条就把结果网页保存为PDF，文件名用表格C列的“Vatid with country code”值，保存到默认目录。
• 尝试整合教程代码时遇到两个问题：
  1. 不知道如何调用PDF保存的相关代码。
  2. 出现报错：> "the code in the project must be updated for use on 64-bit"

你的表格结构 #

Column A       Column B       Column C                   Column D
comments       Country Code   Vatid with country code    Vatid Valid/ Not valid
IT             IT             IT01802840023              01802840023

你的现有VBA代码 #

Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const READYSTATE_COMPLETE As Long = 4
Private m_WebBrowser As SHDocVw.WebBrowser

Public Sub CheckVats2()
    Dim ws As Excel.Worksheet
    Dim RowCount As Long
    Set ws = ActiveWorkbook.Sheets("Sheet1")
    
    For RowCount = 1 To ws.UsedRange.Rows.Count - 1
        InitializeWebBrowser
        SubmitVat ws.Range("A1").Offset(RowCount, 1).Value, ws.Range("A1").Offset(RowCount, 3).Value
        ws.Range("A1").Offset(RowCount, 0).Value = ValidationResult()
    Next RowCount
    
    Set ws = Nothing
    FinalizeWebBrowser
End Sub

Private Sub FinalizeWebBrowser()
    'ToDo: Close
    Set m_WebBrowser = Nothing
End Sub

Private Sub InitializeWebBrowser()
    If m_WebBrowser Is Nothing Then
        Set m_WebBrowser = CreateObject("internetexplorer.application")
        m_WebBrowser.Visible = True
    End If
    m_WebBrowser.navigate "http://ec.europa.eu/taxation_customs/vies/vatRequest.html"
    
    Do While m_WebBrowser.busy
        DoEvents
    Loop
    Do While m_WebBrowser.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
End Sub

Private Sub SubmitVat(ACountryCode As String, AVatID As String)
    Dim CountryCode As MSHTML.IHTMLElement
    Dim VatID As MSHTML.IHTMLElement
    
    Sleep 3000
    Set CountryCode = m_WebBrowser.Document.getElementById("countryCombobox")
    CountryCode.Value = ACountryCode
    
    Set VatID = m_WebBrowser.Document.getElementById("number")
    VatID.Value = AVatID
    
    m_WebBrowser.Document.getElementsByName("check")(0).Click
    
    Do While m_WebBrowser.busy
        DoEvents
    Loop
    Do While m_WebBrowser.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    
    Set CountryCode = Nothing
    Set VatID = Nothing
End Sub

Private Function ValidationResult() As String
    Dim Document As MSHTML.HTMLDocument
    Dim Table As MSHTML.HTMLTable
    Dim Span As MSHTML.IHTMLElement
    Dim FName As String
    Dim FPath As String
    
    ValidationResult = "UNKNOWN"
    Set Document = m_WebBrowser.Document
    Set Table = Document.getElementById("vatResponseFormTable")
    
    If Not Table Is Nothing Then
        Set Span = Table.querySelector(".invalidStyle")
        If Not Span Is Nothing Then
            ValidationResult = "INVALID"
        End If
        
        Set Span = Table.querySelector(".validStyle")
        If Not Span Is Nothing Then
            ValidationResult = "VALID"
        End If
    End If
    
    Set Span = Nothing
    Set Table = Nothing
    Set Document = Nothing
End Function

完整解决方案代码 #

下面是修改后的代码，已经解决了64位兼容性问题，并且整合了PDF保存功能：

Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
        ByVal hwnd As LongPtr, ByVal lpOperation As String, _
        ByVal lpFile As String, ByVal lpParameters As String, _
        ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
        ByVal hwnd As Long, ByVal lpOperation As String, _
        ByVal lpFile As String, ByVal lpParameters As String, _
        ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Private Const READYSTATE_COMPLETE As Long = 4
Private Const SW_HIDE As Long = 0
Private m_WebBrowser As SHDocVw.WebBrowser

Public Sub CheckVats2()
    Dim ws As Excel.Worksheet
    Dim RowCount As Long
    Dim pdfFileName As String
    Dim defaultSavePath As String
    
    Set ws = ActiveWorkbook.Sheets("Sheet1")
    ' 默认保存目录：优先用当前工作簿所在目录，未保存则用用户文档目录
    defaultSavePath = ThisWorkbook.Path
    If defaultSavePath = "" Then defaultSavePath = Environ("USERPROFILE") & "\Documents"
    
    For RowCount = 1 To ws.UsedRange.Rows.Count - 1
        InitializeWebBrowser
        SubmitVat ws.Range("A1").Offset(RowCount, 1).Value, ws.Range("A1").Offset(RowCount, 3).Value
        ws.Range("A1").Offset(RowCount, 0).Value = ValidationResult()
        
        ' 获取C列的VAT编号作为PDF文件名
        pdfFileName = ws.Range("A1").Offset(RowCount, 2).Value & ".pdf"
        ' 调用PDF保存函数
        SaveWebPageAsPDF m_WebBrowser, defaultSavePath & "\" & pdfFileName
    Next RowCount
    
    Set ws = Nothing
    FinalizeWebBrowser
End Sub

Private Sub FinalizeWebBrowser()
    ' 关闭IE浏览器（之前的代码漏了关闭操作）
    If Not m_WebBrowser Is Nothing Then
        m_WebBrowser.Quit
        Set m_WebBrowser = Nothing
    End If
End Sub

Private Sub InitializeWebBrowser()
    If m_WebBrowser Is Nothing Then
        Set m_WebBrowser = CreateObject("internetexplorer.application")
        m_WebBrowser.Visible = True
    End If
    m_WebBrowser.navigate "http://ec.europa.eu/taxation_customs/vies/vatRequest.html"
    
    Do While m_WebBrowser.busy
        DoEvents
    Loop
    Do While m_WebBrowser.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
End Sub

Private Sub SubmitVat(ACountryCode As String, AVatID As String)
    Dim CountryCode As MSHTML.IHTMLElement
    Dim VatID As MSHTML.IHTMLElement
    
    Sleep 3000
    Set CountryCode = m_WebBrowser.Document.getElementById("countryCombobox")
    CountryCode.Value = ACountryCode
    
    Set VatID = m_WebBrowser.Document.getElementById("number")
    VatID.Value = AVatID
    
    m_WebBrowser.Document.getElementsByName("check")(0).Click
    
    Do While m_WebBrowser.busy
        DoEvents
    Loop
    Do While m_WebBrowser.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    
    Set CountryCode = Nothing
    Set VatID = Nothing
End Sub

Private Function ValidationResult() As String
    Dim Document As MSHTML.HTMLDocument
    Dim Table As MSHTML.HTMLTable
    Dim Span As MSHTML.IHTMLElement
    
    ValidationResult = "UNKNOWN"
    Set Document = m_WebBrowser.Document
    Set Table = Document.getElementById("vatResponseFormTable")
    
    If Not Table Is Nothing Then
        Set Span = Table.querySelector(".invalidStyle")
        If Not Span Is Nothing Then
            ValidationResult = "INVALID"
        End If
        
        Set Span = Table.querySelector(".validStyle")
        If Not Span Is Nothing Then
            ValidationResult = "VALID"
        End If
    End If
    
    Set Span = Nothing
    Set Table = Nothing
    Set Document = Nothing
End Function

Private Sub SaveWebPageAsPDF(ByVal ie As SHDocVw.WebBrowser, ByVal savePath As String)
    Dim tempHtmlPath As String
    Dim shellResult As Variant
    
    ' 先把网页保存为临时HTML文件
    tempHtmlPath = Environ("TEMP") & "\temp_vat_verification.html"
    ie.Document.SaveAs tempHtmlPath, 0 ' 0代表HTML格式
    
    ' 调用系统默认PDF打印机打印HTML到指定PDF文件
    shellResult = ShellExecute(0, "printto", tempHtmlPath, """" & savePath & """", "", SW_HIDE)
    
    ' 等待打印完成（可根据实际速度调整毫秒数）
    Sleep 5000
    
    ' 删除临时HTML文件
    On Error Resume Next
    Kill tempHtmlPath
    On Error GoTo 0
End Sub

关键修改说明 #

1. 64位兼容性修复：

   • 使用#If VBA7 Then条件编译，为32位和64位Office分别声明API函数，确保代码在两种环境下都能运行。
   • 所有API声明都添加了PtrSafe关键字（对应64位）。

2. PDF保存功能整合：

   • 新增SaveWebPageAsPDF子过程，负责将IE中的网页转为PDF：
     • 先把网页保存为临时HTML文件。
     • 调用ShellExecute的printto命令，用系统默认的虚拟PDF打印机（比如Microsoft Print to PDF）将HTML转为指定路径的PDF。
     • 打印完成后自动删除临时文件。
   • 在CheckVats2循环中，每次验证完成后调用SaveWebPageAsPDF，用C列的VAT编号作为文件名。

3. 其他优化：

   • 完善了FinalizeWebBrowser过程，添加了关闭IE的代码，避免残留进程。
   • 处理了默认保存路径的逻辑：如果工作簿未保存，就保存到用户的文档目录。

使用注意事项 #

• 确保你的Windows系统安装了虚拟PDF打印机（Windows 10及以上默认自带Microsoft Print to PDF）。
• 如果PDF保存速度慢，可以调整SaveWebPageAsPDF中的Sleep 5000数值（单位是毫秒），比如改成Sleep 10000（10秒）。
• 运行代码前，打开VBA编辑器的工具->引用，确保勾选了Microsoft Internet Controls和Microsoft HTML Object Library。

内容的提问来源于stack exchange，提问作者neelesh agarwal