【源码】VBA或VB使用二进制方式合并和拆分多个word doc文件或图片文件

tmtony

最近一个客户项目，需要对多个文件进行合并与拆分，研究了一番，对相关网上代码收集梳理了一下，分享给大家
注意:在Access环境，要将 App.Path 改为 Currentproject.path
VBA或VB使用二进制方式合并和拆分多个word doc文件或图片文件:
Private Sub Command1_Click()'多个word doc文件或图片文件合并
    Dim Buff() As Byte, i As Integer, Flen As Long, PicFlen As Long
    Dim DocName() As Byte, DocLen As Long
    For i = 1 To 3
        Open App.Path & "\b" & i & ".doc" For Binary Access Read As #11
            Flen = LOF(11)
            ReDim Buff(1 To Flen)
            Get #11, , Buff
        Close #11
        DocName = StrConv("b" & i & ".doc", vbFromUnicode)
        DocLen = UBound(DocName) + 1
        Open App.Path & "\AllInOne.exe" For Binary Access Write As #22
            PicFlen = LOF(22)
            Seek #22, PicFlen + 1    '设置写入点
            Put #22, , Buff    '合并数据
            Put #22, , DocName    '追加文件名数据
            Put #22, , Flen    '追加合并文件长度，4个字节
            Put #22, , DocLen    '追加合并文件名长度，4个字节
        Close #22
    Next
    MsgBox "文件合并完毕！"
End Sub

Private Sub Command2_Click()'多个word doc文件或图片文件拆分
    Dim Buff() As Byte, i As Integer, Flen As Long, PicFlen As Long
    Dim DocName() As Byte, DocLen As Long, P As Long, Pos As Long, S As String
    Open App.Path & "\AllInOne.exe" For Binary Access Read As #22
        Flen = LOF(22)
        ReDim Buff(1 To 4)
        For i = 1 To 3
            Pos = Flen - 8
            Seek #22, Pos + 1    '设置写入点
            Get #22, , Flen
            Get #22, , DocLen
            ReDim Buff(1 To DocLen)
            Pos = Pos - DocLen
            Seek #22, Pos + 1
            Get #22, , Buff
            S = App.Path & "\" & StrConv(Buff, vbUnicode)
            If Dir(S) <> "" Then Kill S
            Open S For Binary Access Write As #11
                Pos = Pos - Flen
                Seek #22, Pos + 1
                ReDim Buff(1 To Flen)
                Get #22, , Buff
                Put #11, , Buff
            Close #11
            Flen = Pos
        Next
        Seek #22, 1
        ReDim Buff(1 To Flen)
        Get #22, , Buff
    Close #22
    Kill App.Path & "\AllInOne.exe"
    Open App.Path & "\AllInOne.exe" For Binary Access Write As #11
        Put #11, , Buff
    Close #11
    MsgBox "文件拆分完毕！"

End Sub   
'原作者： ljl88900

ui

谢谢分享

tmtony

这个倒真没有试过，不过是二进制方式，应该还原出来还是原来的格式，不会影响。

玉树TMD临风

记号，我的Word文件中有20150626.wav文件，双击后可以播放的，不知道这种文件在合并时有没有影响？