Help with a Save as PDF Macro

Hi all,

I am trying to program macro to save my current drawing as a PDF file. I found a macro on the net that does this and it works great. However, I wanted to modify it to add the drawing revision to the file name. I know others have attempted the same thing, but I can't seem to get the code to run.

I would appreciate it if some who knows better could review the code and find my mistake. The trouble seems to be in the way I am trying to get the value for the revision parameter from the drawing. Iv'e tried lots of aproaches, but it seems I am not getting the correct object.

Much appreciated.

Dave Seebauer

Dim SwApp As SldWorks.SldWorks Dim Model As SldWorks.ModelDoc2 Dim MyPath, ModName, NewName As String Dim MB As Boolean Dim Errs As Long Dim Warnings As Long Dim reesolvedValOut, revTag As String Dim swConfigMgr As SldWorks.ConfigurationManager Dim swConfig As SldWorks.Configuration Dim swCustPropMgr As SldWorks.CustomPropertyManager

Sub main()

Set SwApp = Application.SldWorks

' This ensures that there are files loaded in SolidWorks Set Model = SwApp.ActiveDoc Set swConfigMgr = Model.ConfigurationManager Set swConfig = swConfigMgr.ActiveConfiguration

If Model Is Nothing Then MB = MsgBox("No drawing loaded!", vbCritical) Exit Sub End End If

'Get Revision Tag Set swCustPropMgr = swConfig.CustomPropertyManager Set void = swCustPropMgr.Get2("Revision", revTag, reesolvedValOut)

' Admonish user if attempted to run macro on part or assy file If Model.GetType 3 Then SwApp.SendMsgToUser "Current document is not a drawing." End End If

' Use one of the three following options for PDF save location ' Comment out the options with are not used.

' Option 1: Use the current directory ' MyPath = CurDir ' ' Option 2: Specify the directory you want to use ' MyPath = "C:\PDF"

' Option 3: Use the drawing folder MyPath = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") -

' Status ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") -

MsgBox "Save " & NewName & " to" & Chr(13) & MyPath & Chr(13) & Chr(13) & "(No notification will occur " & Chr(13) & "for success PDF creation.)"

' PDF Creation MB = Model.SaveAs4(MyPath & "\" & NewName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)

' Warnings to user on Error ' MsgBox "Errors: " & Errs & vbCrLf & "Warnings: " & Warnings If Warnings 0 Then MsgBox "There were warnings. PDF creation may have failed. Verify" & Chr(13) & "results and check possible causes.", vbExclamation Else End If

If MB = False Then MsgBox "PDF creation has failed! Check save location, available" & Chr(13) & "disk space or other possible causes.", vbCritical Else End If

'Clear immediate values Set Model = Nothing Set MyPath = Nothing

End Sub