SoftMaker.de

Dim tm as Object, fs as object, dr as object, sfd as object

'Variable für das Quellverzeichnis ohne Schlussbackslash:
d1 = "C:\verzeichnis1\verzeichnis2"

Set tm = CreateObject("TextMaker.Application")
tm.Application.Visible = True
tm.Activate
Set fs = CreateObject("Scripting.FileSystemObject")

Set dr = fs.GetFolder(d1)
For each dateiname in dr.files
   umbenennen
next dateiname

For Each f1 In fs.GetFolder(d1).SubFolders
   Set dr = fs.GetFolder(f1)
   For each dateiname in dr.files
      umbenennen
   next dateiname
   For Each f2 In fs.GetFolder(f1).SubFolders
      Set dr = fs.GetFolder(f2)
      For each dateiname in dr.files
         umbenennen
      next dateiname
      For Each f3 In fs.GetFolder(f2).SubFolders
         Set dr = fs.GetFolder(f3)
         For each dateiname in dr.files
            umbenennen
         next dateiname
      Next
   Next
Next

function umbenennen()
   If right(dateiname, 3) = "tmd" or right(dateiname, 3) = "TMD" then
      tm.Documents.Open dateiname
      x = Len(tm.activedocument.FullName) - 3
      nm = left (tm.activedocument.FullName,x) & "DOC"
      tm.ActiveDocument.SaveAs nm, tmFormatWinWordXP
      tm.ActiveDocument.Close
   end if
end function