急問：如何將匯入(插入)大量的WORD檔，並且"自動加上檔名"？

[jed958]

請教各位前輩
若想將一個資料夾內的所有WORD檔合併，並且在每個WORD檔的第一行"自動加上個別的檔名"
再空一行為內文，接著空三行
假設有A、B、C三個WORD檔案，x為內文，如何做到以下排列(檔案插入順序可不用指定)
示意圖：
.................................
A(檔案A的檔名)
(空一行)
aaaaaa　
aaaaaa　(檔案B內文)
aaaaaa
(空三行)

B(檔案B的檔名)
(空一行)
bbbbbb
bbbbbb　(檔案B內文)
bbbbbb
(空三行)

C(檔案C的檔名)
(空一行)
cccccc
cccccc　 (檔案C內文)
cccccc

[jed958]

補充一下
我知道WORD有一次插入多個檔案的功能(插入→檔案→用滑鼠選取多個檔案)
但無法自動加上檔名，且我的檔案有數百個，後來想到用巨集功能
以前從沒用過巨集功能，在google上一找才發現巨集功能有多好用...
但只試出 錄製新巨集的方式插入自動圖文集的檔名，加上插入多個檔案
可是出現的檔名都是目前的檔名，無法自動抓取連續插入的個別檔名

曾想過修改leonchou的這篇
[VBA] 批次插入多個文字檔 http://www.pczone.com.tw/vbb3/showth...t=%A5%A8%B6%B0


但實在做不出來......很急.... >_< help....

[Coder]

我一樣是用leonchou君的例子作修改的。
Sub Insert_Doc()
mypath = Options.DefaultFilePath(wdDocumentsPath)
mypath = InputBox("請輸入路徑名稱 (例如 C:\Temp)：", "插入文字檔", mypath)

'設定編號 A ,B ,C ,......，設定為A開頭
serial = 65

If mypath = "" Then Exit Sub Else On Error GoTo Z
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
myfile = Dir(mypath & "*.doc", vbDirectory)
While myfile <> ""

'插入編號
Selection.TypeText Text:=Chr(serial)
'編號加1
serial = serial + 1

'換行
Selection.TypeParagraph
Selection.TypeParagraph

Selection.InsertFile mypath & myfile
myfile = Dir()

'換行
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph

Wend
Z:
End Sub