Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell") Dim f, p, fc Dim PS_Titel Dim sFile , sPath Dim lFileCount
Set p = fso.GetFolder("C:NetzwerkPS-Dateien") set f = p.Files
for each fc in f PS_Titel = Find_PSTitel(p.Path & "" & fc.Name) exit for 'Ausstieg aus Schleife, da nur ein PS-Titel benötigt wird. Next
'PDF-Dateiname und Pfad erstellen sFile=Get_Filename (PS_Titel) sPath=Get_Path(PS_Titel)
'Konvertierung mit FreePDF_Multidoc ausführen 'Pfade bitte anpassen Wshshell.run """C:NetzwerkFreePDF_Multidoc.exe""" & "/f " & sFile & "/p " & sPath
do while p.files.Count > 0 '1 sec. Warten, bis auch alle Dateien konvertiert wurden 'nur so kann FreePDF_Multidoc erkennen, dass auch eine Konvertierung erfolgte. WScript.sleep 1 loop
Function Find_PSTitel(Datei) 'PS-Titel aus der Postscript-Datei auslesen
Dim FileIn Dim tmpStr
Set FileIn = FSO.OpenTextFile(Datei, 1 ) ' Datei zum Lesen öffnen
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen tmpStr = FileIn.Readline If InStr(1, tmpStr, "%%Title:", vbTextCompare) 0 Then 'Gefunden Find_PSTitel= Trim(Right(tmpStr, Len(tmpStr) - Len("%%Title:"))) Exit Do End If Loop
End Function
Function Get_Filename(PS_Titel) 'Der PS-Titel wird jetzt aufgespalten in einzelne Bestandteile, 'um daraus einen Dateinamen und Speicherpfad zu extrahieren
'PS-Titel lautet z. B.: ESt 2008 Formulare - Mustermann (13806) 'Der Speichername soll lauten: ESt-Formulare
Get_Filename = left(PS_Titel,3) & "-" & Mid(PS_Titel,Len("ESt 2008 ")+1,Len("Formulare"))
End Function
Function Get_Path(PS_Titel) dim tmp 'Zwischenwert dim p 'Speicherpfad = v:13813806ESt2008
p= p & left(tmp,3) & "" & tmp 'MdNr mit Unterverzeichnissen p =p & "" & Left(PS_Titel,3) 'Pfad mit ESt ergänzen
tmp = mid(PS_Titel,Len("ESt ")+1,4) 'Jahreszahl extrahieren p=p & "" & tmp 'Pfad mit Jahreszahl ergänzen
Get_Path = p
End Function
Dieses Script könnte z. B. auch Grundlage für ein Plug-In sein, da die Dateinamensvergabe in FreePDF_Multidoc nur für einfache Fälle gedacht ist.
Viel Spaß.
FreePDF_Multidoc (PS2PDF mit vielen Optionen f. FreePDF) File2PDF (komplette Verzeichnisse auf einen Streich umwandeln) findest Du alles hier: http://amTools.de
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell") Dim f, p, fc Dim PS_Titel Dim sFile , sPath Dim lFileCount
'--> neu
Dim myObject dim x
'Verweis auf die Printjobs.dll im VBS-Verzeichnis 'Code wird erst weiter ausgeführt, wenn auch alle Ausdrucke erfolgten. set myObject=createObject("Printjobs.Druckauftrag") x= myObject.Dokument_in_Spool("FreePDF_PS",,True)
'--> Ende neu
Set p = fso.GetFolder("C:NetzwerkPS-Dateien") set f = p.Files
for each fc in f PS_Titel = Find_PSTitel(p.Path & "" & fc.Name) exit for 'Ausstieg aus Schleife, da nur ein PS-Titel benötigt wird. Next
'PDF-Dateiname und Pfad erstellen sFile=Get_Filename (PS_Titel) sPath=Get_Path(PS_Titel)
'Konvertierung mit FreePDF_Multidoc ausführen 'Pfade bitte anpassen Wshshell.run """C:NetzwerkFreePDF_Multidoc.exe""" & "/f " & sFile & "/p " & sPath
do while p.files.Count > 0 '1 sec. Warten, bis auch alle Dateien konvertiert wurden 'nur so kann FreePDF_Multidoc erkennen, dass auch eine Konvertierung erfolgte. WScript.sleep 1 loop
Function Find_PSTitel(Datei) 'PS-Titel aus der Postscript-Datei auslesen
Dim FileIn Dim tmpStr
Set FileIn = FSO.OpenTextFile(Datei, 1 ) ' Datei zum Lesen öffnen
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen tmpStr = FileIn.Readline If InStr(1, tmpStr, "%%Title:", vbTextCompare) 0 Then 'Gefunden Find_PSTitel= Trim(Right(tmpStr, Len(tmpStr) - Len("%%Title:"))) Exit Do End If Loop
End Function
Function Get_Filename(PS_Titel) 'Der PS-Titel wird jetzt aufgespalten in einzelne Bestandteile, 'um daraus einen Dateinamen und Speicherpfad zu extrahieren
'PS-Titel lautet z. B.: ESt 2008 Formulare - Mustermann (13806) 'Der Speichername soll lauten: ESt-Formulare
Get_Filename = left(PS_Titel,3) & "-" & Mid(PS_Titel,Len("ESt 2008 ")+1,Len("Formulare"))
End Function
Function Get_Path(PS_Titel) dim tmp 'Zwischenwert dim p 'Speicherpfad = v:13813806ESt2008
p= p & left(tmp,3) & "" & tmp 'MdNr mit Unterverzeichnissen p =p & "" & Left(PS_Titel,3) 'Pfad mit ESt ergänzen
tmp = mid(PS_Titel,Len("ESt ")+1,4) 'Jahreszahl extrahieren p=p & "" & tmp 'Pfad mit Jahreszahl ergänzen
Get_Path = p
End Function
FreePDF_Multidoc (PS2PDF mit vielen Optionen f. FreePDF) File2PDF (komplette Verzeichnisse auf einen Streich umwandeln) findest Du alles hier: http://amTools.de