标题: 【源码】VBA或VB使用二进制方式合并和拆分多个word doc文件或图片文件 [打印本页] 作者: tmtony 时间: 2015-6-27 10:05 标题: 【源码】VBA或VB使用二进制方式合并和拆分多个word doc文件或图片文件 最近一个客户项目，需要对多个文件进行合并与拆分，研究了一番，对相关网上代码收集梳理了一下，分享给大家 注意:在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 "文件拆分完毕！"