title image


Smiley Re: 100 Word Datein in eine Datei aber wie?
Ich habe hier eine W97-Makrolösung, die hat mir mal jemand zur Verfügung gestellt.

Vielleicht hilft Dir das Weiter:



W97-Mehrere Dokumente zu einem Dokument zusammenführen

Problem:

In einem Verzeichnis stehen beliebig viele *.doc-Dateien (reinrassig, ausschliesslich *.doc!) die zu einem gemeinsamen Dokument zusammengefasst werden sollen.

Um hier nicht unendliche Handarbeit leisten zu müssen, wurde diese Makrolösung programmiert



Voraussetzung für das Funktionieren ist, dass im Quellverzeichnis (hier im Beispiel: D:\WORKAREA) alle zusammenführenden *.docs enthalten sind. Dateien, die nicht *.doc - Objekte sind, führen zum Absturz des Makros.



Lösung: (Makroquellcode)



Sub Dateienzusammenfuehren()

'achtung: Quellverzeichnis (Laufwerk + Verzeichnis) jeweils anpassen

' oder alles in d:\workarea kopieren

'Dim Datei$

Dim Zaehler

ReDim Liste__$(0)

Dim Index_

Dim Verzeichnis$

Dim Laufwerk$

'hier muss ggf. Laufwerk und Verzeichnis geändert werden

Laufwerk$ = "D:"

Verzeichnis$ = "\workarea"

ChDrive Laufwerk$

ChDir Verzeichnis$

Datei$ = WordBasic.[Files$]("*.*")

If Datei$ = "" Then

MsgBox "Keine Dateien vorhanden!", 48

Else

'Leere Datei laden

Documents.Add

'Dokumente zaehlen

Zaehler = -1

While Datei$ ""

Zaehler = Zaehler + 1

Datei$ = WordBasic.[Files$]()

Wend

' Dateinamen in Liste einlesen

ReDim Liste__$(Zaehler)

Liste__$(0) = WordBasic.[Files$]("*.*")

For Index_ = 1 To Zaehler

Liste__$(Index_) = WordBasic.[Files$]()

Next

WordBasic.SortArray Liste__$()

For Index_ = 0 To Zaehler

Selection.InsertFile FileName:=Liste__$(Index_)

Next

End If

End Sub

Eine andere Makrolösung könnte z.B. so aussehen (ist aber noch nicht getestet):



Vorwiegend WordBasic und nicht VBA. (Ganz ohne WordBasic geht es tatsächlich nicht, weil VBA keine Sort-Methode kennt.)



Kodierung wie folgt:



PublicSub MehrereDateienZusammenfuehren()

Dim x() As String

Verzeichnis = "C:\Eigene Dateien"

i = -1

dName = Dir(Verzeichnis & "\*.doc"

While Not dName = ""

i = i + 1

Redim Preserve x(i)

dName = Dir

Wend

Anz = i

If Anz > 0 Then WordBasic.SortArray x()

If Anz > -1 Then

Dim nDoc As Document, oRange As Range

Set nDoc = Documents.Add

For i = 0 To Anz

Set oRange = nDoc.Range

oRange.SetRange Start:=oRange.End + 1, End:=oRange.End + 1

oRange.Select

Selection.InsertFile FileName:=x(i)

Next i

End If

End Sub





Und hier noch eine Lösung:



1. Stelle sicher, dass das Verzeichnis nur die gewünschten Word-Dokumente enthält

2. Stelle sicher, dass diese Dokumente kein Passwort zum Öffnen benötigen

3. Stelle sicher, dass diese Dokumente keine Automationsroutinen enthalten

4. Erstelle ein neues Word-Dokument in einem anderen Verzeichnis als dieses mit dem Dateien, welche zu "mergen" sind

5. Kopiere folgende Routine im VBA-Editor in ein neues Modul dieses neu erstellten Dokumentes

6. Passe im Kopf des Codes die Konstante mit dem Namen "Verzeichnis" an

7. Makro ausführen





Gruss

Peter







Private Const Verzeichnis = "D:\WORKAREA"

Private Const Filter = "*.doc"



Sub SuchenErsetzenGanzesVerzeichnis()

Dim oDoc As Document, oRange As Range

With Application.FileSearch

.LookIn = Verzeichnis

.FileName = Filter

.Execute SortBy:=msoSortByFileName

Anzahl = .FoundFiles.Count

Application.ScreenUpdating = False

i = 0

For Each aDoc In .FoundFiles

i = i + 1

If i = 1 Then

Set oDoc = Documents.Open(FileName:=aDoc)

Else

Set oRange = oDoc.Content

oRange.SetRange Start:=oRange.End, End:=oRange.End

oRange.InsertBreak Type:=wdSectionBreakNextPage

oRange.InsertFile FileName:=aDoc

End If

StatusBar = Anzahl & " Dokumente verarbeitet..bitte warten."

DoEvents

Next

End With

StatusBar = Anzahl & " Dokumente verarbeitet. - Ende!"

DoEvents

End Sub





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: