求VB合并WORD文档?

[aodzl]

1.把若干WORD文档合并到一个文档中.
2.查找当前目录下的今天创建的WORD文档.

两个问题,望各位大大给予指点.
最好可以给出详细代码.
谢谢先.

[SoHo_Andy]

问题1
文件名使用变量，插入文件位置可以使用书签来定位

Private Sub cmd合并文档_Click()
Dim WordTemps As New Word.Application
WordTemps.Documents.Add App.Path + "\母文档.doc", False

WordTemps.Selection.InsertFile FileName:="d:\aa.doc", _
Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
WordTemps.Selection.InsertFile FileName:="d:\bb.doc", _
Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False

WordTemps.Visible = True

End Sub

[SoHo_Andy]

'问题2
Dim strFileName() As String
Private Sub Command1_Click()
Dim i As Integer
Call 查找文件
For i = 0 To UBound(strFileName) - 1
Debug.Print strFileName(i)
Next
End Sub
Sub 查找文件()
Dim filename As String
Dim fs, f, s, filespec
Dim j As Long
j = -1
'filename = Dir(App.Path & "\*.doc")
filename = Dir("d:\*.doc")
Do While filename <> ""
If filename <> "." And filename <> ".." Then
Set fs = CreateObject("Scripting.FileSystemObject")
'Set f = fs.GetFile(App.Path & "\" & filename)
Set f = fs.GetFile("d:\" & filename)
If DateDiff("d", f.DateCreated, Now) = 0 Then
j = j + 1
ReDim Preserve strFileName(j + 1)
strFileName(j) = filename
End If
End If
filename = Dir ' 查找下一个文件。
Loop
End Sub

[aodzl]

恩，谢谢大家。
揭帖

[busisoft]

'合并word文档
Dim WordApp As Application

On Error Resume Next
Set WordApp = GetObject(, "word.application")
If Err Then
Err.Clear
Set WordApp = CreateObject("word.application")
If Err Then
MsgBox ("不能运行WORD，请检查是否安装了WORD！")
Exit Sub
End If
End If
WordApp.Visible = False
WordApp.Documents.Add
WordApp.Selection.InsertFile (App.Path + "\doc\ss01.doc")
WordApp.Selection.InsertFile (App.Path + "\doc\3-1b.doc")
WordApp.ActiveDocument.SaveAs (App.Path + "\doc\JSS.doc")

WordApp.Documents.Close
WordApp.Quit
Set WordApp = Nothing

[busisoft]

查找当前目录下的今天创建的WORD文档.
用SoHo_Andy(冰) 就不错