VBA解码Base64为PDF时触发‘字符串空间不足’错误的解决方法

原代码依赖MSXML2 DOM节点的Text属性处理Base64字符串，当字符串过长（比如对应164页PDF的Base64）时，会触发VBA的"Out of string space"内存溢出错误——原因是DOM节点在处理超长文本时存在内存限制。

解决方案：分块解码Base64字符串 #

通过将大Base64字符串拆分为多个小的、符合Base64格式的块，逐块解码后合并字节数组，避免一次性加载整个大字符串到内存中。

修改后的完整代码 #

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal Length As LongPtr _
)

Private Sub Apply_Click()
    Dim strPath As String
    Dim b64 As String
    Dim userParts As Variant
    
    userParts = Split(Application.UserName, " ")
    b64 = FinalResult
    strPath = "C:\Users\" & userParts(1) & "\Downloads\" & ConsignmentNumber & " Invoice.pdf"
    
    SaveBase64ToFile b64, strPath
End Sub

Private Sub SaveBase64ToFile(base64Str As String, filePath As String)
    Dim decodedBytes() As Byte
    decodedBytes = DecodeBase64Large(base64Str)
    
    Open filePath For Binary As #1
        Put #1, 1, decodedBytes
    Close #1
End Sub

Private Function DecodeBase64Large(base64Str As String) As Byte()
    Dim objXML As Object
    Dim objNode As Object
    Dim chunkSize As Long
    Dim totalChunks As Long
    Dim currentChunk As Long
    Dim chunkStr As String
    Dim chunkBytes() As Byte
    Dim finalBytes() As Byte
    Dim finalLength As Long
    Dim chunkByteLength As Long
    
    ' 设置分块大小（必须是4的倍数，适配Base64编码规则）
    chunkSize = 4096
    totalChunks = (Len(base64Str) + chunkSize - 1) \ chunkSize
    
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    
    For currentChunk = 0 To totalChunks - 1
        ' 提取当前块的Base64字符串
        chunkStr = Mid(base64Str, currentChunk * chunkSize + 1, chunkSize)
        
        ' 确保块长度为4的倍数，补全必要的=符号
        Do While Len(chunkStr) Mod 4 <> 0
            chunkStr = chunkStr & "="
        Loop
        
        ' 解码当前块
        objNode.Text = chunkStr
        chunkBytes = objNode.nodeTypedValue
        chunkByteLength = UBound(chunkBytes) - LBound(chunkBytes) + 1
        
        ' 合并到最终字节数组
        If currentChunk = 0 Then
            finalLength = chunkByteLength
            ReDim finalBytes(0 To finalLength - 1)
            finalBytes = chunkBytes
        Else
            finalLength = finalLength + chunkByteLength
            ReDim Preserve finalBytes(0 To finalLength - 1)
            ' 高效复制字节块（比循环赋值快数倍）
            CopyMemory finalBytes(finalLength - chunkByteLength), chunkBytes(0), chunkByteLength
        End If
    Next currentChunk
    
    ' 清理对象
    Set objNode = Nothing
    Set objXML = Nothing
    
    DecodeBase64Large = finalBytes
End Function

关键说明 #

• 分块大小：设置为4的倍数（如4096、8192），保证每块Base64字符串合法，可根据内存情况调整大小
• 内存复制API：使用CopyMemory替代循环赋值，大幅提升大字节数组合并的效率
• 32位VBA适配：如果运行在32位Office环境，需将PtrSafe和LongPtr改为Long
• 合法性校验：自动补全块末尾的=符号，确保Base64块可正常解码

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