Macro to save active drawing as PDF file into selected output folder and close drawing
This VBA macro performs the following steps with the active SOLIDWORKS drawing:
- Shows Browse For Folder dialog to select the output folder for the PDF file
- Saves the active drawing as PDF file into the folder selected in the previous step. File name of the PDF will be the same as file name of the drawing
- If the original drawing was modified, macro saves the changes
- Closes the active SOLIDWORKS drawing document
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swDraw As SldWorks.ModelDoc2
Set swDraw = swApp.ActiveDoc
If swDraw Is Nothing Then
Err.Raise vbError, "", "Open drawing"
End If
If swDraw.GetType() = swDocumentTypes_e.swDocDRAWING Then
Dim outFolder As String
outFolder = BrowseForFolder()
If Right(outFolder, 1) = "\" Then
outFolder = Left(outFolder, Len(outFolder) - 1)
End If
If outFolder <> "" Then
Dim outFileName As String
outFileName = GetFileNameWithoutExtension(swDraw.GetPathName()) & ".pdf"
Dim outFilePath As String
outFilePath = outFolder & "\" & outFileName
Dim errs As Long
Dim warns As Long
If False = swDraw.Extension.SaveAs(outFilePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errs, warns) Then
Err.Raise vbError, "", "Failed to export PDF to " & outFile
End If
If False <> swDraw.GetSaveFlag() Then
If False = swDraw.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errs, warns) Then
Err.Raise vbError, "", "Failed to save drawing"
End If
End If
swApp.CloseDoc swDraw.GetTitle
End If
Else
Err.Raise vbError, "", "Active document is not a drawing"
End If
End Sub
Function GetFileNameWithoutExtension(filePath As String) As String
GetFileNameWithoutExtension = Mid(filePath, InStrRev(filePath, "\") + 1, InStrRev(filePath, ".") - InStrRev(filePath, "\") - 1)
End Function
Function BrowseForFolder(Optional title As String = "Select Folder") As String
Dim shellApp As Object
Set shellApp = CreateObject("Shell.Application")
Dim folder As Object
Set folder = shellApp.BrowseForFolder(0, title, 0)
If Not folder Is Nothing Then
BrowseForFolder = folder.Self.Path
End If
End Function