Hallo Marco,
 ich arbeite mit Office 2000, denke aber, dass mein Lösungsvorschlag keine Probleme bereiten sollte. Da Fußnoten am Ende eines Dokumentes als Endnoten aufgefasst werden, müssen nicht nur die Fußnoten, sondern auch die Endnoten berücksichtigt werden. Sichere deine Dokumente, bevor du das Programm laufen lässt!!! 
  
 Sub Fussnotentausch()
 alterName = "alter Firmenname, der ersetzt werden soll"
 altLen = Len(alterName)
 neuerName = "neuer Firmenname"
 pfad = "Pfad des Stammordneres (z.B. c:\......)"
 Set fso = CreateObject("Scripting.FileSystemObject") 'Zugriff auf das Dateiensystem
 Set Fldr = fso.getfolder(pfad)
 Set SFldr = Fldr.subfolders 'Auflistungsobjekt für die Unterordner
 For Each UtrOrd In SFldr 'Zugriff auf die Auflistung
     Set Datn = UtrOrd.files 'Auflistungsobjekt der Dateien im jeweiligen Unterordner
     For Each Datei In Datn 'Zugriff auf die Dateien
         If LCase(Right(Datei, 3)) = "doc" Then 'ist Datei Word-Dokument? Hoffentlich keine weiteren .doc!"
             Documents.Open FileName:=Datei.Path 'wenn ja, öffne Dokument
             a = ActiveDocument.Footnotes.Count 'Anzahl der Fußnoten
             b = ActiveDocument.Endnotes.Count 'Anzahl der Endnoten
             If a > 0 Then
                 For i = 1 To a
                     ActiveDocument.Footnotes(i).Range.Select 'Markieren der jeweiligen Fußnote
                     t = Selection.Text 
                     c = 0 : c = InStr(t, alterName) 'ist alter Name enthalten?
                     If c Then
                         t = Left(t, c - 1) + neuerName + Mid(t, c + altLen) 'falls ja, ersetzen
                         Selection.TypeText Text:=t
                     End If
                 Next i
             End If
             If b > 0 Then 'dito für Endnoten
                 For i = 1 To a
                     ActiveDocument.Endnotes(i).Range.Select
                     t = Selection.Text
                     c = 0 : c = InStr(t, alterName)
                     If c Then
                         t = Left(t, c - 1) + neuerName + Mid(t, c + altLen)
                         Selection.TypeText Text:=t
                     End If
                 Next i
             End If
             If c > 0 Then ActiveDocument.Save 'Speichern des Dokuments bei Änderung
             Documents.Close 'Schließen der dokumente
         End If
     Next
 Next
 End Sub
 
 Viel Erfolg
 Holger
 
 
 
 Marco schrieb am 19.12.2007 08:49:58:
 
 [Word 2003]
 
 Hallo liebe VBA-Freunde,
 
 bisher hatte ich noch nichts mit VBA zu tun, nun möchte ich aber folgendes Problem zu lösen:
 
 In einem Stammordner gibt es weitere Unterordner, die alphabetisch angelegt sind. In diesen Unterordnern liegen Dokumente verschiedener Typen, z.B. PDF-Dokumente, Word-Dokumente.
 
 Manche Word-Dokumente enthalten Profile von Mitarbeitern. Deren Dateiname beginnt mit "Profil_". Diese Dokumente enthalten in der Fusszeile Angaben zum Firmennamen. Dieser hat sich nun geändert, und nun möchte ich automatisiert im Stammordner alle Unterordner bzw. alle darin enthaltenen Dateien durchlaufen. Ist die gefundene Datei ein Profil wie oben beschrieben, soll in der Fusszeile der Text der Firmenabgabe ersetzt werden.
 
 Weiss jemand, wie so was geht? Im einzelnen interessiert mich, wie ich sauber alle Dateien nebst Unterordnern im Stammordner durchsuchen kann, und wie ich Text in einer Fusszeile ersetzen kann.
 
 Es handelt sich um sehr viele Profile, d.h. das Makro sollte effizient sein.
 
 Ich habe bereits das Tool "Globales Suchen und Ersetzen" gefunden, kann dieses Add-In jedoch nicht anwenden.
 
 Wer kann mir helfen?
 
 Vielen Dank im voraus!
 
 Grüße,
 Marco     |