· Sub AppendDoc()
Dim strSourceFile As String
Dim strPath As String
Dim strFile As String
Dim doc As Document
Dim rng As Range
On Error GoTo ErrHandler
' Prompt the user to select a source file
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Please select the document to be inserted"
If .Show = False Then
MsgBox "You didn't select a document.", vbExclamation
Exit Sub
End If
strSourceFile = .SelectedItems(1)
End With
' Prompt the user to select a folder
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select the folder to process"
If .Show = False Then
MsgBox "You didn't select a folder.", vbExclamation
Exit Sub
End If
strPath = .SelectedItems(1)
End With
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Application.ScreenUpdating = False
' Loop through the Word documents in the folder
strFile = Dir(strPath & "*.doc*")
Do While strFile <> ""
Set doc = Documents.Open(strPath & strFile)
doc.Content.InsertParagraphAfter
Set rng = doc.Content
rng.Collapse Direction:=wdCollapseEnd
rng.InsertFile FileName:=strSourceFile, Link:=False
doc.Close SaveChanges:=True
strFile = Dir
Loop
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
Ik heb deze macro gevonden en hij werkt.
Maar hij zou wat aangepast moeten worden:
- het ingevoegde document moet steeds op een nieuwe pagina beginnen en niet vlak achter de ingevoegde tekst.
- het ingevoegde document moet ook steeds in portrait staan.
Is er iemand die weet hoe ik da macro kan aanpassen?
