Attribute VB_Name = "Zapis_PDF_Forum1"
Sub main()
Dim swApp              As SldWorks.SldWorks
Dim swModel            As SldWorks.ModelDoc2
Dim Folder             As String
Dim FileName           As String
Dim Slash              As Integer

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "No current document", vbCritical
End
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "This Macro only works on Drawings", vbCritical, "Save as PDF"
End
End If
Set swModelDocExt = swModel.Extension
Set swExportData = swApp.GetExportFileData(swExportPdfData)
FileName = swModel.GetPathName
If FileName = "" Then
   MsgBox "Please save the file first and try again", vbCritical, "Save as PDF"
   End
End If
Slash = InStrRev(FileName, "\")
If Slash = 0 Or Slash >= Len(FileName) Then
 Slash = InStr(FileName, ":")
 If Slash = 0 Or Slash >= Len(FileName) Then MsgBox "File name error . . .", vbCritical, "Save as PDF": End
End If
Folder = Left(FileName, Slash)
Folder = InputBox("Folder name :", "Save as PDF", Folder)
If Folder = "" Then End

If Right(Folder, 1) <> "\" Then Folder = Folder + "\"
FileName = Folder + swModel.GetTitle
If Dir(Folder + "*.*") = "" Then MsgBox "Folder : " & Folder & " not exist . . . ", vbExclamation, "Save as PDF": End
FileName = Strings.Left(FileName, Len(FileName) - 6) & ".PDF"
 Dim lErrors             As Long
 Dim lWarnings           As Long
boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
boolstatus = swModel.Extension.SaveAs(FileName, 0, 0, swExportData, lErrors, lWarnings)
If boolstatus Then
   MsgBox "Save as PDF successful" & vbNewLine & FileName
Else
   MsgBox "Save as PDF failed, Error code:" & lErrors
End If
End Sub