[求助]文件合并

tingliu

在一个目录下，有很多文件。请问如何自动将两个文件合并成一个文件？

yuyvtul

插入——文件，选中所有文件。

tingliu

这个方法行不通。比如说一个目录下有1000个文件，要将其中每二个合并成一个，最后得500个文件。如果用你推荐的方法，岂不是人都要累疯掉

tingliu

我要做的是形如附件的事情。文件名都有规律：如将txt0001.doc与ans0001.doc合并。 CgTob5xu.rar (14.23 KB, 下载次数: 11)

2006-12-24 18:51 上传

点击文件名下载附件

[此贴子已经被作者于2006-12-24 18:51:53编辑过]

huangyun

搜索一下我最近一个月问过的帖子,内容与你相似的.代码可以直接使用.

tingliu

好象行不通。不管怎样，还是要谢谢你

poetbox

我考！那是什么

守柔

QUOTE:

以下是引用tingliu在2006-12-24 18:51:03的发言：
我要做的是形如附件的事情。文件名都有规律：如将txt0001.doc与ans0001.doc合并。

请参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2006-12-28 6:33:47
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0119^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit

Sub DocMerge()
    Dim MyDialog As FileDialog, oItem As Variant, strA As String, strB As String
    Dim These() As String, Those() As String, myDoc As Document, myRange As Range
    Dim A As Integer, B As Integer, FullNm() As String, Fname As String
    strA = "ans"
    strB = "txt"
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show = -1 Then    '确定
            If .SelectedItems.Count Mod 2 <> 0 Then
                MsgBox "不对称的文件数量,Word无法完成两两合作操作!", vbExclamation + vbInformation, "Excelhome"
                Exit Sub
            Else
                For Each oItem In .SelectedItems    '在所有选取项目中循环
                    FullNm = Split(oItem, "\")
                    Fname = FullNm(UBound(FullNm))
                    Fname = VBA.LCase(Left(Fname, 3))
                    If Fname = strA Then
                        ReDim Preserve These(A)
                        These(A) = oItem
                        A = A + 1
                    ElseIf Fname = strB Then
                        ReDim Preserve Those(B)
                        Those(B) = oItem
                        B = B + 1
                    End If
                Next
            End If
        End If
    End With
  

守柔

 If A <> B Then
        MsgBox "不对称的文件数量,Word无法完成两两合作操作!", vbExclamation + vbInformation, "Excelhome"
        Exit Sub
    Else
        A = 0
        For A = 0 To B - 1
            Set myDoc = Documents.Open(FileName:=These(A), Visible:=False)
            With myDoc
                .Content.InsertAfter Chr(13)
                Set myRange = .Range(.Content.End - 1, .Content.End - 1)
                myRange.InsertFile FileName:=Those(A)
                .Close True
            End With
        Next
    End If
End Sub
'----------------------

tingliu

谢谢守柔斑主