Problem mit Script Recorder/Stapelverarbeitung :/

[koter]

Hallo Schmutzbrust,

Code:

Sub BildHintergrund()
   Dim ZPfad As String, Pfad As String, Datei As String, Name1 As String, BildName As String
   Dim HGDok As Document, Bild As Document
   Dim Z As Integer
   Dim ImpFilt As ImportFilter
   Dim ExpFilt As ExportFilter
   Dim IsJpg As Boolean
   Dim Antw
   Z = 0
   BildName = "HGBild"
   Set HGDok = ActiveDocument
   Pfad = HGDok.FilePath
   ZPfad = Pfad & "Zielordner"
   ZPfad = ZPfad & "\"
   Name1 = Dir(ZPfad, vbDirectory)
   If Name1 = "" Then MkDir ZPfad
   Datei = HGDok.FileName
   Name1 = Dir(Pfad, vbDirectory)
   Do While Name1 <> ""
       IsJpg = Right(Name1, 4) = ".jpg"
       If Name1 <> "." And Name1 <> ".." And Name1 <> Datei And IsJpg Then
           Set ImpFilt = HGDok.Import(Pfad & Name1)
           ImpFilt.Finish
           Set ExpFilt = HGDok.Export(ZPfad & Name1, cdrJPEG)
           ExpFilt.Finish
           HGDok.Layers(1).Delete
           Z = Z + 1
       End If
       Name1 = Dir
   Loop
   Antw = MsgBox(Z & " Dateien erstellt." & vbCrLf & "Zielordner öffnen?", vbYesNo)
   If Antw = vbYes Then Shell "explorer.exe /e, " & ZPfad, vbNormalFocus
End Sub

Wenn Du die Meldung am Schluss nicht möchtest, lösche die beiden Zeilen vor „End Sub“

Gruß

Koter