Mittwoch, 23. März 2011

Word-Dokumente zusammenfassen

Mein aktuelles Problem: Mehrere Word-Dokumente sollten in einem neuem Dokument zusammengefasst werden.

Zwei mögliche Lösungen bieten sich an:
1. Neues Word-Dokument erstellen, Einfügen, Objekt, „Text aus Datei”
2. Ein Makro erstellen, dass alle Dateien in einem bestimmten Ordner öffnet und in eine neue Datei einfügt (ohne Beachtung einer eventuell gewünschten Reihenfolge).

Da mir Variante 2 besser gefällt (*grins*) folgt der verwendete code:

Sub ConcatenateAllWordFiles()
 Dim mypath
 mypath = BrowseFolder("Verzeichnis Wählen")
 
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set Folder = fso.GetFolder(mypath)
 Set allFiles = Folder.Files
 Set newDoc = Documents.Add

 For Each file In allFiles
    If Right(file, 5) = ".docx" Then

        Documents.Open FileName:=file.Path
        current = ActiveDocument.Name
        Selection.WholeStory
        Selection.Copy
        Documents(current).Close
        newDoc.Activate
        Selection.Paste
        Selection.EndKey Unit:=wdLine
    End If
 Next
End Sub

Function BrowseFolder(Title As String, _
        Optional InitialFolder As String = vbNullString, _
        Optional InitialView As Office.MsoFileDialogView = _
            msoFileDialogViewList) As String
    Dim V As Variant
    Dim InitFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = Title
        .InitialView = InitialView
        If Len(InitialFolder) > 0 Then
            If Dir(InitialFolder, vbDirectory) <> vbNullString Then
                InitFolder = InitialFolder
                If Right(InitFolder, 1) <> "\" Then
                    InitFolder = InitFolder & "\"
                End If
                .InitialFileName = InitFolder
            End If
        End If
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            V = vbNullString
        End If
    End With
    BrowseFolder = CStr(V)
End Function

Das ist natürlich nicht alles meine alleinige Idee, die Grobe Vorlage war dies.
Wie BrowseFolder-Funktion habe ich komplett „gefunden”...

1 Kommentar: