Sub main()


'*************************************************************************************************************************
' Basierend auf dem "Create folder" Script von vpt.se und chadjac
' Based On the "Create folder" script from vpt.se und chadjac
' https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/8758-create-folder-script
'*************************************************************************************************************************


'-------------------------------------------------------------------------------------------------------------------------
' Erstellt die Objekte
' Create the objects
'-------------------------------------------------------------------------------------------------------------------------
Dim pcdapp As Object
Set pcdapp = createobject("pcdlrn.application")

Dim pcdpartprogram As Object
Set pcdpartprogram = pcdapp.activepartprogram

Dim fso As Object
Set fso = createobject("scripting.filesystemobject")


'-------------------------------------------------------------------------------------------------------------------------
' Findet die PC-DMIS Variable für den Protokoll Speicherpfad
' Gets the PC-DMIS variable For the protocol path
'-------------------------------------------------------------------------------------------------------------------------
Dim pathname As Object
Set pathname=pcdpartprogram.getvariablevalue("V_PROTOKOLL_PFAD")

strpath=pathname.stringvalue


'-------------------------------------------------------------------------------------------------------------------------
' Prüft ob der Protokoll Speicherpfad existiert & erstellt ihn wenn nicht
' Checks If the protocol path exists And creates it If Not
'-------------------------------------------------------------------------------------------------------------------------
Dim fsofolder As Object

If Not fso.folderexists(strpath) Then
Set fsofolder = fso.createfolder(strpath)
End If



'-------------------------------------------------------------------------------------------------------------------------
' Räumt auf
' Tidies up
'-------------------------------------------------------------------------------------------------------------------------
Set fso = Nothing
Set pcdpartprogram = Nothing
Set pcdapp = Nothing


End Sub