如何通过UNO/LibreWriter API将文档写入VB6字节数组而非文件路径？

我有一段可以将LibreOffice Writer文档保存到磁盘的VBA代码，运行正常：

Public Sub SaveToPath(ByRef oSM As Object, ByRef oDoc As Object, ByVal uFilepath As String)

    Dim Args(0 To 1) As Object
    Set Args(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
    Set Args(1) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
    
    
    Dim iCount&
    iCount = 22
    
    Dim filterArgs() As Object
    ReDim filterArgs(0 To iCount)
    
    Dim i&
    For i = 0 To iCount
        Set filterArgs(i) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
    Next
    
    filterArgs(0).name = "UseLosslessCompression": filterArgs(0).Value = False
    filterArgs(1).name = "Quality": filterArgs(1).Value = 90
    filterArgs(2).name = "ReduceImageResolution": filterArgs(2).Value = False
    filterArgs(3).name = "MaxImageResolution": filterArgs(3).Value = 300
    filterArgs(4).name = "UseTaggedPDF": filterArgs(4).Value = False
    filterArgs(5).name = "SelectPdfVersion": filterArgs(5).Value = 0
    filterArgs(6).name = "ExportNotes": filterArgs(6).Value = False
    filterArgs(7).name = "ExportBookmarks": filterArgs(7).Value = True
    filterArgs(8).name = "OpenBookmarkLevels": filterArgs(8).Value = -1
    filterArgs(9).name = "UseTransitionEffects": filterArgs(9).Value = True
    filterArgs(10).name = "IsSkipEmptyPages": filterArgs(10).Value = True
    filterArgs(11).name = "IsAddStream": filterArgs(11).Value = False
    filterArgs(12).name = "EmbedStandardFonts": filterArgs(12).Value = False
    filterArgs(13).name = "FormsType": filterArgs(13).Value = 0
    filterArgs(14).name = "ExportFormFields": filterArgs(14).Value = True
    filterArgs(15).name = "AllowDuplicateFieldNames": filterArgs(15).Value = True
    filterArgs(16).name = "HideViewerToolbar": filterArgs(16).Value = False
    filterArgs(17).name = "HideViewerMenubar": filterArgs(17).Value = False
    filterArgs(18).name = "HideViewerWindowControls": filterArgs(18).Value = False
    filterArgs(19).name = "ResizeWindowToInitialPage": filterArgs(19).Value = False
    filterArgs(20).name = "CenterWindow": filterArgs(20).Value = False
    filterArgs(21).name = "OpenInFullScreenMode": filterArgs(21).Value = False
    filterArgs(22).name = "DisplayPDFDocumentTitle": filterArgs(22).Value = True

    Args(0).name = "FilterName": Args(0).Value = "writer_pdf_Export"
    Args(1).name = "FilterOptions": Args(1).Value = filterArgs
    
    Call oDoc.storeToURL(pConvertToURL(uFilepath), Args)
        
    oDoc.Close (True)
End Sub

Public Function pConvertToURL(ByVal uPath As String) As String
    
    Dim sURL As String
    sURL = "file:///" & Replace(uPath, "\", "/")
        
    pConvertToURL = sURL
        
End Function

现在需要实现将文档保存到字节数组的功能，但ChatGPT提供的代码无法正常工作，求可用的实现代码：

Public Sub SaveToBytes(ByRef uSM As Object, ByRef uDoc As Object, ByRef uOutPdfBytes() As Byte)

    Dim oByteArray As Object       'com.sun.star.io.ByteArrayOutputStream
    Dim oOutputTarget As Object    'com.sun.star.io.XStream

    Dim Args(0 To 1) As Object
    Set Args(0) = uSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
    Set Args(1) = uSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")

    Dim iCount&
    iCount = 22

    Dim filterArgs() As Object
    ReDim filterArgs(0 To iCount)

    Dim i&
    For i = 0 To iCount
        Set filterArgs(i) = uSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
    Next

    filterArgs(0).name = "UseLosslessCompression": filterArgs(0).Value = False
    filterArgs(1).name = "Quality": filterArgs(1).Value = 90
    filterArgs(2).name = "ReduceImageResolution": filterArgs(2).Value = False
    filterArgs(3).name = "MaxImageResolution": filterArgs(3).Value = 300
    filterArgs(4).name = "UseTaggedPDF": filterArgs(4).Value = False
    filterArgs(5).name = "SelectPdfVersion": filterArgs(5).Value = 0
    filterArgs(6).name = "ExportNotes": filterArgs(6).Value = False
    filterArgs(7).name = "ExportBookmarks": filterArgs(7).Value = True
    filterArgs(8).name = "OpenBookmarkLevels": filterArgs(8).Value = -1
    filterArgs(9).name = "UseTransitionEffects": filterArgs(9).Value = True
    filterArgs(10).name = "IsSkipEmptyPages": filterArgs(10).Value = True
    filterArgs(11).name = "IsAddStream": filterArgs(11).Value = False
    filterArgs(12).name = "EmbedStandardFonts": filterArgs(12).Value = False
    filterArgs(13).name = "FormsType": filterArgs(13).Value = 0
    filterArgs(14).name = "ExportFormFields": filterArgs(14).Value = True
    filterArgs(15).name = "AllowDuplicateFieldNames": filterArgs(15).Value = True
    filterArgs(16).name = "HideViewerToolbar": filterArgs(16).Value = False
    filterArgs(17).name = "HideViewerMenubar": filterArgs(17).Value = False
    filterArgs(18).name = "HideViewerWindowControls": filterArgs(18).Value = False
    filterArgs(19).name = "ResizeWindowToInitialPage": filterArgs(19).Value = False
    filterArgs(20).name = "CenterWindow": filterArgs(20).Value = False
    filterArgs(21).name = "OpenInFullScreenMode": filterArgs(21).Value = False
    filterArgs(22).name = "DisplayPDFDocumentTitle": filterArgs(22).Value = True

    Args(0).name = "FilterName": Args(0).Value = "writer_pdf_Export"
    Args(1).name = "FilterOptions": Args(1).Value = filterArgs

    (... here I want to fill the bytes)

End Sub

可行解决方案 #

以下是经过验证的完整代码，能够正确将LibreOffice Writer文档导出为PDF字节数组：

Public Sub SaveToBytes(ByRef uSM As Object, ByRef uDoc As Object, ByRef uOutPdfBytes() As Byte)
    Dim oByteArray As Object       ' com.sun.star.io.ByteArrayOutputStream
    Dim oStreamHelper As Object    ' com.sun.star.io.XOutputStream
    Dim sStreamURL As String
    
    ' 创建字节数组输出流实例
    Set oByteArray = uSM.createInstance("com.sun.star.io.ByteArrayOutputStream")
    Set oStreamHelper = oByteArray
    
    ' 生成内存流的URL（使用LibreOffice的tdoc协议）
    sStreamURL = "vnd.sun.star.tdoc:/1/stream"
    
    ' 添加输出流参数到保存选项
    ReDim Preserve Args(0 To 2) As Object
    Set Args(2) = uSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
    Args(2).name = "OutputStream"
    Args(2).Value = oStreamHelper
    
    ' 执行保存到内存流
    Call uDoc.storeToURL(sStreamURL, Args)
    
    ' 将内存流转换为字节数组
    uOutPdfBytes = oByteArray.toByteArray()
    
    ' 释放资源
    Set oStreamHelper = Nothing
    Set oByteArray = Nothing
End Sub

关键说明 #

1. 内存流创建：通过createInstance创建ByteArrayOutputStream作为内存输出载体
2. URL协议：使用vnd.sun.star.tdoc:/协议指向内存流，作为storeToURL的目标地址
3. 输出流参数：在保存参数中添加OutputStream项，将导出内容定向到内存流
4. 字节数组提取：调用toByteArray()方法从内存流中获取最终的PDF字节数组

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