SoftMaker.de

tm.ActiveDocument.SaveAs

REM Versuch TM Automation Dateikonversion
Set tm = CreateObject("TextMaker.Application")
tm.Application.Visible = True

DIM x, y, z AS Long

DIM DateitypB(17) AS String
   DateitypB(0)="TextMaker-Dokument"
   DateitypB(1)="Dokumentvorlage"
   DateitypB(2)="Microsoft Word für Windows 97 und 2000"
   DateitypB(3)="OpenDocument, OpenOffice.org, StarOffice"
   DateitypB(4)="Rich Text Format"
   DateitypB(5)="Pocket Word auf dem Pocket PC"
   DateitypB(6)="Pocket Word auf dem Handheld PC"
   DateitypB(7)="Textdatei mit Windows-Zeichensatz"
   DateitypB(8)="Textdatei mit DOS-Zeichensatz"
   DateitypB(9)="Textdatei mit Unicode-Zeichensatz"
   DateitypB(10)="Textdatei mit UTF8-Zeichensatz"
   DateitypB(11)="HTML"
   DateitypB(12)="Microsoft Word fr Windows 6.0"
   DateitypB(13)="Textdatei für UNIX, Linux, FreeBSD"
   DateitypB(14)="Microsoft Word für Windows XP und 2003"
   DateitypB(15)="TextMaker-Dokument, Version 2006"
   DateitypB(16)="OpenXML (DOCX)"
   DateitypB(17)="TextMaker-Dokument, Version 2008"


Begin Dialog DIALOG_1 147,49, 200, 92, "Quellformat"
  Text 4,4,188,24, "Wählen Sie den Dateityp der Quelldateien aus der Liste unten aus."
  DropListBox 4,36,144,32, DateitypB(), .DropDown_1
  OKButton 160,60,24,20
End Dialog

DIM Dlg1 AS DIALOG_1

Begin Dialog DIALOG_2 147,49, 200, 92, "Zielformat"
  Text 4,4,188,24, "Wählen Sie den Dateityp der Zieldateien aus der Liste unten aus."
  DropListBox 4,36,144,32, DateitypB(), .DropDown_1
  OKButton 160,60,24,20
End Dialog

DIM Dlg2 AS DIALOG_2

x=Dialog(Dlg1)
y=Dlg1.DropDown_1
if y>10 then y=y+1

Set sl = CreateObject("Shell.Application")
Set ordner = sl.BrowseForFolder(0, "Bitte den zu konvertierenden Ordner auswählen.", 0, 0)
        If not ordner is Nothing then
           quellordnername = ordner.self.Path
        Else
          MsgBox "Kein Ordner gefunden!"
          End
        End If

x=Dialog(Dlg2)
z=Dlg2.DropDown_1
Select Case z
Case 0, 15, 17
   endg="tmd"
Case 1
   endg="tmv"
Case 2, 12, 14
   endg="doc"
Case 3
   endg="odt"
Case 4
   endg="rtf"
Case 5
   endg="psw"
Case 6
   endg="pwd"
Case 11
   endg="htm"
Case 7, 8, 9, 10, 13
   endg="txt"
Case 16
   endg="docx"
End Select
if z>10 then z=z+1

Set ordner = sl.BrowseForFolder(0, "Bitte den Ziel-Ordner auswählen.", 0, 0)
        If not ordner is Nothing then
           zielordnername = ordner.self.Path
        Else
          MsgBox "Kein Ordner gefunden!"
          End
        End If

Set fs = CreateObject("Scripting.FileSystemObject")
Set dr = fs.GetFolder(quellordnername)
For each dateiname in dr.files
   tm.Documents.Open dateiname, Empty, Empty, Empty, y
dname=tm.ActiveDocument.Name
l=len(dname)
test=Right(dname, 5)
test=LCase(test)
If test=".docx" Then l=l-4 Else l=l-3
dname=mid(dname, 1, l)
neuername=zielordnername+"\"+dname+endg
     tm.ActiveDocument.SaveAs neuername, z
   tm.ActiveDocument.Close smoDoNotSaveChanges
next
tm.Application.Quit
Set tm = Nothing
End