Language="VBSCRIPT"

'--------------------------------------------------------------------------------
' Script um CATDrawings nach PDF zu konvertieren.
' Script written by Dipl.-Ing. Maximilianus (CAD.DE)
' 
' !!! Die Verwendung dieses Skripts erfolgt auf eigene Gefahr! !!!

' Es wird keine Garantie für Datenverlust, die Datenqualität oder für sonstige
' vertragliche oder rechtliche Verpflichtungen übernommen, die der Anwender dieses 
' Skriptes gegenüber seinem Kunden oder Dritten eingegangen ist.
'--------------------------------------------------------------------------------

Sub CATMain()
CATIA.DisplayFileAlerts = False
s1="Script um CATDrawings nach PDF zu konvertieren." & vbCrLf &  "Script written by Dipl.-Ing. Maximilianus (CAD.DE)"
s2="!!! Die Verwendung dieses Skripts erfolgt auf eigene Gefahr! !!!"
s3="Es wird keine Garantie für Datenverlust, die Datenqualität oder für sonstige" & vbCrLf & "vertragliche oder rechtliche Verpflichtungen übernommen, die der Anwender dieses" & vbCrLf & "Skriptes gegenüber seinem Kunden oder Dritten eingegangen ist."
MsgBox s1 & vbCrLf & vbCrLf & s2 & vbCrLf & vbCrLf & s3 & vbCrLf

set ShellApp=CreateObject("Shell.Application") 'erzeuge ein neues Objekt "Shell Application"
set FolBrowser=ShellApp.BrowseForFolder(0,"Quellverzeichnis ist C:\Temp. Zum Übernehmen 'Abbrechen', oder wählen Sie ein Verzeichnis, in dem die CATDrawings gespeichert sind:",16,17)
folderinput = "C:\Temp"
If not FolBrowser is Nothing then 'wenn nicht Abbrechen gedrückt oder aus sonstigen Gründen 
'nichts im Objekt "FolBrowser" steht, dann...
folderinput=FolBrowser.Self.Path '...speichere den Pfad d. Ordners in die Variable "folderinput"
End If


Dim fs, fso, fld, sfld, ssfld, sssfld, ssssfld, f, f1, fc, s, filename, t
Dim SheetCollection As DrawingSheets 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set fso = CreateObject("Scripting.FileSystemObject")

Set fld = fso.GetFolder(folderinput)

Set fc = fld.Files
For Each fil In fc
t = fil.Type
If t = "CATIA Drawing" then
  filename = fil.Name
  Pos1 = instr(1, s, filename)
  If Pos1 = 0 Then
Set documents1 = CATIA.Documents
PFADEINGABE =  fld & "\" & fil.name
Set document1 = documents1.Open(PFADEINGABE)
CATIA.ActiveWindow.WindowState = 0
Set drawingDocument1 = CATIA.ActiveDocument
fileoutname = replace(fil.name,".CATDrawing","")
PFADAUSGABE = fld & "\" & fileoutname & ".pdf"
drawingDocument1.ExportData PFADAUSGABE, "pdf"
drawingDocument1.Close 
s = s & PFADEINGABE & ";" & PFADAUSGABE
s = s & vbCrLf 
  End if
End if
Next

For Each sfld In fld.SubFolders
  Set fc = sfld.Files
  For Each fil In fc
t = fil.Type
If t = "CATIA Drawing" then
  filename = fil.Name
  Pos1 = instr(1, s, filename)
      If Pos1 = 0 Then
  Set documents1 = CATIA.Documents
  PFADEINGABE =  sfld & "\" & fil.name
  Set document1 = documents1.Open(PFADEINGABE)
CATIA.ActiveWindow.WindowState = 0
Set drawingDocument1 = CATIA.ActiveDocument
fileoutname = replace(fil.name,".CATDrawing","")
PFADAUSGABE = sfld & "\" & fileoutname & ".pdf"
drawingDocument1.ExportData PFADAUSGABE, "pdf"
drawingDocument1.Close 
s = s & PFADEINGABE & ";" & PFADAUSGABE
s = s & vbCrLf 
  End if
End if
  Next

For Each ssfld In sfld.SubFolders
  Set fc = ssfld.Files
  For Each fil In fc
t = fil.Type
If t = "CATIA Drawing" then
  filename = fil.Name
  Pos1 = instr(1, s, filename)
  If Pos1 = 0 Then
  Set documents1 = CATIA.Documents
  PFADEINGABE =  ssfld & "\" & fil.name
  Set document1 = documents1.Open(PFADEINGABE)
CATIA.ActiveWindow.WindowState = 0
Set drawingDocument1 = CATIA.ActiveDocument
fileoutname = replace(fil.name,".CATDrawing","")
PFADAUSGABE = ssfld & "\" & fileoutname & ".pdf"
drawingDocument1.ExportData PFADAUSGABE, "pdf"
drawingDocument1.Close 
s = s & PFADEINGABE & ";" & PFADAUSGABE
s = s & vbCrLf 
  End if
End if
  Next

For Each sssfld In ssfld.SubFolders
  Set fc = sssfld.Files
  For Each fil In fc
t = fil.Type
If t = "CATIA Drawing" then
  filename = fil.Name
  Pos1 = instr(1, s, filename)
  If Pos1 = 0 Then
  Set documents1 = CATIA.Documents
  PFADEINGABE =  sssfld & "\" & fil.name
  Set document1 = documents1.Open(PFADEINGABE)
CATIA.ActiveWindow.WindowState = 0
Set drawingDocument1 = CATIA.ActiveDocument
fileoutname = replace(fil.name,".CATDrawing","")
PFADAUSGABE = sssfld & "\" & fileoutname & ".pdf"
drawingDocument1.ExportData PFADAUSGABE, "pdf"
drawingDocument1.Close 
s = s & PFADEINGABE & ";" & PFADAUSGABE
s = s & vbCrLf 
  End if
End if
  Next

For Each ssssfld In sssfld.SubFolders
  Set fc = ssssfld.Files
  For Each fil In fc
t = fil.Type
If t = "CATIA Drawing" then
  filename = fil.Name
  Pos1 = instr(1, s, filename)
    If Pos1 = 0 Then
Set documents1 = CATIA.Documents
PFADEINGABE =  ssssfld & "\" & fil.name
Set document1 = documents1.Open(PFADEINGABE)
CATIA.ActiveWindow.WindowState = 0
Set drawingDocument1 = CATIA.ActiveDocument
fileoutname = replace(fil.name,".CATDrawing","")
PFADAUSGABE = ssssfld & "\" & fileoutname & ".pdf"
drawingDocument1.ExportData PFADAUSGABE, "pdf"
drawingDocument1.Close 
s = s & PFADEINGABE & ";" & PFADAUSGABE
s = s & vbCrLf 
  End if
End if
  Next
  Next
Next
Next
Next

' FileSystemObject objFs oeffnen
Set objFs= CreateObject("Scripting.FileSystemObject")
strDateiname = folderinput + "\" + "Drawing2PDF-DeepStructure-Report.csv"
Set objTextStream = objFs.CreateTextFile(strDateiname, True)
strWriteString = s
objTextStream.Write strWriteString
objTextStream.Close
Set objTextStream = Nothing
Set objFs = Nothing

MsgBox "fertig !" & vbCrLf & s & vbCrLf
End Sub