Hier noch die Beta-Version des entsprechenden Skripts für PM wieder mit der Bitte um Korrekturen und Fehlermeldungen - die Numerierung der Formate ist auch hier wieder intern abgefangen, versteht sich.
Code:
REM Versuch PM Automation Dateikonversion
Set pm = CreateObject("PlanMaker.Application")
pm.Application.Visible = True
DIM x, y, z AS Long
DIM DateitypB(20) AS String
DateitypB(0)="PlanMaker-Dokument"
DateitypB(1)="Dokumentvorlage"
DateitypB(2)="Excel 97/2000/XP"
DateitypB(3)="Excel 5.0/7.0"
DateitypB(4)="Excel-Vorlage"
DateitypB(5)="Sylk"
DateitypB(6)="Rich Text Format"
DateitypB(7)="HTML"
DateitypB(8)="dBASE-Datenbank im DOS-Zeichensatz"
DateitypB(9)="dBASE-Datenbank im Windows-Zeichensatz"
DateitypB(10)="Textdatei mit Windows-Zeichensatz (DIF)"
DateitypB(11)="Textdatei mit Windows-Zeichensatz (ANSI)"
DateitypB(12)="Textdatei mit DOS-Zeichensatz"
DateitypB(13)="Textdatei mit ANSI-Zeichensatz für UNIX, Linux und FreeBSD"
DateitypB(14)="Textdatei mit Unicode-Zeichensatz"
DateitypB(15)="dBASE-Datenbank mit Unicode-Zeichensatz"
DateitypB(16)="PlanMaker-Dokument, Version 2004"
DateitypB(17)="Textdatei mit UTF8-Zeichensatz"
DateitypB(18)="PlanMaker-Dokument, Version 2006"
DateitypB(19)="OpenXML (XLSX)"
DateitypB(20)="PlanMaker-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>4 then y=y+1
if y>15 then y=y+2
if y>19 then y=y+1
if y=24 then y=25
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, 16, 18, 20
endg="pmd"
Case 1
endg="pmv"
Case 2, 3
endg="xls"
Case 4
endg="xlt"
Case 5
endg="slk"
Case 6
endg="rtf"
Case 7
endg="htm"
Case 8, 9, 15
endg="dbf"
Case 10
endg="dif"
Case 11, 12, 13, 14, 17
endg="txt"
Case 19
endg="xlsx"
End Select
if z>4 then z=z+1
if z>15 then z=z+2
if z>19 then z=z+1
if z=24 then z=25
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
pm.Workbooks.Open dateiname, False, y
dname=pm.ActiveWorkbook.Name
l=len(dname)
test=Right(dname, 5)
test=LCase(test)
If test=".xlsx" Then l=l-4 Else l=l-3
dname=mid(dname, 1, l)
neuername=zielordnername+"\"+dname+endg
pm.ActiveWorkbook.SaveAs neuername, z, Empty, Empty
pm.ActiveWorkbook.Close smoDoNotSaveChanges
next
pm.Application.Quit
Set pm = Nothing
End
Anmelden
Registrieren
FAQ
Suche
