|
Hallo liebe Leute,
nachdem ich die letzten Tage auf Office-Lösungen versucht habe mein Wissen bei meinem Problem zu erweitern bin ich nun hier.
Mein Problem ist folgendes, ich habe ca. 5000 Datensätze als Word-Dokumente die Seit 20 Jahren nicht wirklich gepflegt wurden und nun einmal auf den aktuellen Stand gebracht werden sollen. Das alte Firmenlogo, habe ich per Kopieren+einfügen schon in allen Dokumenten getauscht. Nun muss aber noch die Fußzeile überprüft werden und alles auf eine einheit gebracht werden dazu habe ich grundlegend auch schon ein Makro erstellt, dafür muss ich aber nun jedes Dokument öffnen und das makro ausführen, was auf Dauer sehr mühselig ist. Ich habe auch schon erste versuche mit der Bulk-Verarbeitung versucht bekomme es aber nicht wirklich zum laufen. Mein code sieht so aus.:
Public Sub Alle_Dateien_Komplett()
'//deklarationen
Dim strFileName As String
Dim objDocument As Document
'//Errorhandler initialisieren
On Error GoTo err_exit
Dim strOrdner As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1) <> "\" Then strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
If strOrdner = "" Then MsgBox ("Kein Ordner gewählt!") Else MsgBox strOrdner
'//Schleife starten
Do
'//Dokument öffnen
Set objDocument = Documents.Open(FileName:=strFileName)
Dim oStory As Range
For Each oStory In objDocument.StoryRanges
oStory.Find.ClearFormatting
oStory.Find.Replacement.ClearFormatting
With oStory.Find
.Text = "Suchtext Textkörper"
.Replacement.Text = "Ersatztext Textkörper"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oStory.Find.Execute Replace:=wdReplaceAll
'Jetzt haben wir den Hauptbereich abgearbeitet - nun noch der Rest
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
oStory.Find.ClearFormatting
oStory.Find.Replacement.ClearFormatting
With oStory.Find
.Text = "Suchtext Kopf-, Fußzeile"
.Replacement.Text = "Ersatztext Kopf-, Fußzeile"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oStory.Find.Execute Replace:=wdReplaceAll
Wend
Next
'//Dokument schließen - ohne zu speichern = False / mit speichern = True
objDocument.Close SaveChanges:=True
'//nächstes Dokument suchen
strFileName = Dir$
'//wird kein Dokument mehr gefunden Schleife verlassen
Loop Until strFileName = ""
Exit Sub
err_exit:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehlermeldung"
End Sub
Vielleicht kann mir ja Jemand von Euch helfen und vielleicht ist es ja nur ein kleiner Fehler der sich irgendwo eingeschlichen hat, aber ich verzweifle inzwischen schon fast daran
|