Bilder und Textbausteine auslesen

Hallo,

ich möchte Bilder und Textbausteine aus einem Worddokument auslesen und in ein anderes einfügen.
Da da sehr viele Quelldateien da sind, möchte ich dies gern automatisiert machen. Seht Ihr da einen Lösungsansatz?

Vielen Dank schon mal

René

ich möchte Bilder und Textbausteine aus einem Worddokument
auslesen und in ein anderes einfügen.
Da da sehr viele Quelldateien da sind, möchte ich dies gern
automatisiert machen. Seht Ihr da einen Lösungsansatz?

Hi René,

nimm ein leeres Dokument, Alt+F11, Einfügen Modul, dortrein den Code kopieren, Verzeichnisnamen anpassen, Mit „True“ oder „False“ SearchSubFolders anpassen ob oder ob nicht in Untervezeichnissen des angegeben Verzeichnisses gesucht werden soll.

Sann stelle den Cursor beliebig irgendwo in den Code rein und drücke F5, oder schließe den Editor, in Word dann Extras–Makro–Makro–Makro ausählen—Ausführen…

Das Makro sollte dann alle Bilder aller gefundenen doc-Dateien in das aktuelle leere Dokument schaufeln. Möglicherweise stapelt der Code alle Bilder auf einer Stelle, aber das kann man ja später nch verbessern, hab den Code mal so hingebastelt und nur mit einem Bild getestet da ich auf dem Sprung bin.
Also teste mal und sage halt was so alles pasiert. Ich schaue heute Abend wieder rein.

Probleme könnte es, bzw. wird es, geben wenn da Dokumente Passwörter haben.

Bei den Textbausteinen müßte ich erst mal schauen was das überhaupt für Dinger sind, wie man sie in Vba anspricht usw.

PS: An alle interessierten WordlerInnen hier:
Wie kann ich das unschöne Select vermeiden? S.Copy klappt leider nich -(

Option Explicit
'
Sub Auslesen()
Dim fs, N, S
Set fs = Application.FileSearch
With fs
 .LookIn = "c:\test"
 .FileName = "\*.doc"
 .SearchSubFolders = True
 If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) \> 0 Then
 For N = 1 To .FoundFiles.Count
 Documents.Open .FoundFiles(N)
 For Each S In ActiveDocument.Shapes
 If S.Type = msoPicture Then
 S.Select
 Selection.Copy
 Windows("Dokument1").Activate
 Selection.Paste
 Selection.Collapse
 End If
 Next S
 Documents(.FoundFiles(N)).Close savechanges:=False
 Next N
 Else
 MsgBox "There were no files found."
 End If
End With
End Sub

Gruß
Reinhard

ich möchte Bilder … aus einem Worddokument
auslesen …

Hallo René,
speichere das Dokument als htm. Dann hasst du alle Bilder ohne Qualitätsverlust in einem Ordner.
Grüße
Ulf