MS Access数据库OLE字段存储的Word/PDF文档导出后无法读取求助

问题分析 #

你写的3种导出代码本身逻辑没有错误，导出失败的核心原因是：Access的OLE Object字段存储的不是纯文件二进制内容，而是在真实文件内容前额外加了OLE对象的封装头，包含OLE结构化存储元数据、对象类型标识等信息，你直接把整个字段内容写入文件，生成的自然不是可被Word/Adobe识别的合法文件。

从你贴出的导出文件内容可以验证这一点：内容前半段的Root Entry、CompObj都是OLE结构化存储的标准标识，后半段已经出现了%PDF-1.7的PDF文件标准头，说明真实文件内容就封装在OLE头之后，完全可以提取，不需要知道原始前端的写入逻辑。

解决方案 #

你只需要修改导出逻辑：先根据表中的内容类型字段，匹配对应文件的魔术头（文件起始标识字节），找到真实内容的起始偏移位置，仅将偏移位置之后的二进制内容写入文件即可。

不同文件类型的魔术头匹配规则 #

• PDF文件：查找字节序列%PDF-，从该位置开始导出，保存为.pdf
• 旧版Word(.doc)文件：查找十六进制字节序列D0 CF 11 E0 A1 B1 1A E1，从该位置开始导出，保存为.doc
• 新版Word(.docx)文件：查找十六进制字节序列50 4B 03 04（ZIP格式标准头，docx本质是ZIP压缩包），从该位置开始导出，保存为.docx

优化后的导出代码示例（基于ADODB.Stream实现） #

Dim fullStream As New ADODB.Stream
Dim outputStream As New ADODB.Stream
Dim MyPath As String
Dim fileType As String
Dim findPos As Long
Dim searchBytes() As Byte

' 读取当前行的OLE字段全部内容
fullStream.Type = adTypeBinary
fullStream.Open
fullStream.Write Me!Documents
fullStream.Position = 0

' 根据表中的内容类型字段设置搜索的魔术头和导出路径
fileType = Me!内容类型字段名 ' 替换为你自己表中存储内容类型的字段名
If fileType = "Adobe Acrobat Document" Then
    MyPath = "C:\My path\导出文件.pdf"
    searchBytes = StrConv("%PDF-", vbFromUnicode)
ElseIf fileType = "Microsoft Word Document" Then
    ' 先匹配docx的ZIP头，匹配不到再匹配旧版doc头即可，这里简化示例给doc的匹配
    MyPath = "C:\My path\导出文件.doc"
    searchBytes = Array(&HD0, &HCF, &H11, &HE0, &HA1, &HB1, &H1A, &HE1)
End If

' 查找魔术头的起始位置
findPos = FindByteSequence(fullStream, searchBytes)
If findPos >= 0 Then
    ' 从找到的位置开始读取内容写入输出文件
    fullStream.Position = findPos
    outputStream.Type = adTypeBinary
    outputStream.Open
    fullStream.CopyTo outputStream
    outputStream.SaveToFile MyPath, adSaveCreateOverWrite
    outputStream.Close
End If

fullStream.Close

配套的字节序列查找函数 #

Public Function FindByteSequence(stream As ADODB.Stream, searchSeq() As Byte) As Long
    Dim buffer() As Byte
    Dim i As Long, j As Long
    Dim seqLen As Long
    seqLen = UBound(searchSeq) + 1
    If seqLen = 0 Then FindByteSequence = -1: Exit Function
    
    stream.Position = 0
    buffer = stream.Read()
    
    For i = 0 To UBound(buffer) - seqLen + 1
        For j = 0 To seqLen - 1
            If buffer(i + j) <> searchSeq(j) Then Exit For
        Next j
        If j = seqLen Then
            FindByteSequence = i
            Exit Function
        End If
    Next i
    FindByteSequence = -1 ' 没找到匹配序列
End Function

批量处理优化建议 #

如果你的数据量较大，可以先用十六进制编辑器打开3-5个不同类型的导出样本，观察真实文件头的偏移量是否固定。如果所有同类型文件的OLE头长度是固定的，直接按固定偏移截取内容即可，不需要每次遍历查找，处理效率会高很多。

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