Mbv VBA meerdere documenten samenvoegen

[Enigmasmurf]

Hallo,

Terug van weg geweest en ik zie dat ik ook even terug mee zal moeten spelen.
Mijn voorgaande (noodzakelijke !) suggestie is terug uit de laatste code verdwenen.
Daarnaast zitten er in edmoor's nieuwe code enkele schoonheidsfoutjes.
Bekijk het eens met deze:

Sub VoegDocumentenSamen()
    Dim strPath, strTargetDocument
    Dim strDocName() As String
    Dim intDocCounter As Integer
    
    strPath = GetFolder & "\"
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .InitialFileName = strPath
        .Title = "Selecteer document(en)"
        .Filters.Clear
        .Filters.Add "Word bestanden", "*.doc*"
        If .Show = True Then
            For i = 1 To .SelectedItems.Count
                ReDim Preserve strDocName(i - 1)
                strDocName(i - 1) = .SelectedItems(i)
            Next i
            intDocCounter = i - 2
        End If
    End With
    
    Documents.Add
    strTargetDocument = "Samengevoegd (" & Format(Date, "dd_mm_yyyy") & ").docx"
    For n = 0 To intDocCounter
        Documents.Open (strDocName(n))
        Selection.WholeStory
        Selection.Copy
        ActiveDocument.Close savechanges:=False
        Selection.Paste
    Next n
    ActiveDocument.SaveAs FileName:=strPath & strTargetDocument
End Sub

Uiteraard moet ook de functie GetFolder aanwezig blijven.
Succes !

 

[Jeannette2509]

Ik ben heel er blij en vooral beide dankbaar!

Dit werkt PERFECT Enigmasmurf