Save as PDF with Revision macro

Hi,

I'm trying to modify an existing Macro (by Matt Lorono) that was posted in Eng-Tips, but I am have trouble getting it to work.

If I run the macro it stops at the line:

MBpdf = Model.SaveAs4(MyPathPDF & "\" & NewNamePDF, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)

But in VBA editor program, if I stop (press Reset) the macro and click on the line:

MyPathPDF = "C:\Export" and then click "Continue" the macro works as intended.

I cant figure out why it wont work unless I run it from within the VBA editor

Below is the code that I am using,

Any help would be appreciated,

cheers,

Joe

--

' -----------------------------------------------------------------------------

' Save Drawing as PDF and DXF

' SaveDwgAsPDF.swp - Original functional code by Lee Bell on 02/10/02.

' ------------------------------------------------------------------------------

' Description:

' Saves the active drawing or current view of a model or assembly as a PDF and DXF to a specified directory.

' ------------------------------------------------------------------------------

' Version - By Matthew Lorono, Copyright 2006

'           1.00         * Created Macro from various sources at the above

'                          website.

'                        * Added error handling for no docs loaded.

'                        * Modified error handling for failed save.

'                        * Added/modified comments.

'                        * Cleaned up user interface.

'           1.10         * Add nondrawing support

'                        * Add error handling for missing directory

'           1.20         * Add error handling for missing document path

'                        * Add user input/confirmation of save folder

'           1.21         * Expand header to prohibit money based distribution

'                          (such as for-profit or fee based) of this macro.

'           1.22         * Add save status to lower left status bar pane; some

'                          clean up; add detail to description.

'           1.23         * Added DXF functionality.

' ------------------------------------------------------------------------------

Option Explicit

Dim SwApp As SldWorks.SldWorks

Dim Model As SldWorks.ModelDoc2

Dim swModelDocExt       As SldWorks.ModelDocExtension

Dim swExportPDFData As SldWorks.ExportPdfData

Dim MyPathPDF, MyPathDWG, ModName, NewNamePDF, NewNameDWG As String

Dim Rev As String

Dim dPathName As String

Dim fso As Object

Dim MBpdf, MBdwg As Boolean

Dim Errs As Long

Dim Warnings As Long

Dim swFrame As SldWorks.Frame

Dim Sheet1, FlatPatternSheet As String

Dim strSheetName(4)     As String

Dim varSheetName        As Variant

Dim i                   As Long

Sub main()

 

  Set SwApp = Application.SldWorks

  'SwApp.Visible = True

  Set Model = SwApp.ActiveDoc

  Set swFrame = SwApp.Frame

  Set swModelDocExt = Model.Extension

  Set swExportPDFData = SwApp.GetExportFileData(1)

' Error handler for no document loaded

  If Model Is Nothing Then MsgBox "No document loaded!", vbCritical: End

 

' 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

MyPathPDF = "C:\Export"

MyPathDWG = "C:\Export"

' Option 3: Use the drawing folder

  'MyPathPDF = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") - 1)

  'MyPathDWG = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") - 1)

 

' Call correct sub

' If Model.GetType <> 3 Then Call notdrawing

  If Model.GetType <> 3 Then MsgBox ("This only works for drawings"), vbCritical: End

  Call ifdrawing

End Sub

Sub notdrawing()

MsgBox ("This only works for drawings"), vbCritical: End

End Sub

Sub ifdrawing()

' Set PDF file name

  Rev = Model.CustomInfo("Revision")

  Sheet1 = Model.ActivateSheet("Sheet1")

  ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") - 3) + "Rev" + Rev

 

  Call alldoc

 

End Sub

Sub alldoc()

' See PDF and DXF file name with extention .pdf or .dwg

  NewNamePDF = ModName & ".pdf"

 

' PDF Creation

' MBpdf = swExportPDFData.SetSheets(swExportData_ExportAllSheets, varSheetName)

' MBpdf = swModelDocExt.SaveAs(MyPathPDF & "\" & NewNamePDF, 0, 0, swExportPDFData, Errs, Warnings)

MBpdf = Model.SaveAs4(MyPathPDF & "\" & NewNamePDF, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)

 

' DWG Creation

'varSheetName = Model.GetSheetNames

    'For i = 0 To UBound(varSheetName)

        'MBdwg = Model.ActivateSheet(varSheetName(i))

        'NewNameDWG = ModName & "_" & varSheetName(i) & ".dwg"

        'MBdwg = Model.SaveAs4(MyPathDWG & "\" & NewNameDWG, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)

        'Debug.Assert MBdwg

    'Next i

    ' Switch back to first sheet

    'MBdwg = Model.ActivateSheet(varSheetName(0))

Call last

End Sub

Sub last()

  swFrame.SetStatusBarText "Done"

 

' Clear immediate values

  Set Model = Nothing

  Set MyPathPDF = Nothing

  'Set MyPathDWG = Nothing

  Set swFrame = Nothing

  Set fso = Nothing

 

End Sub

SolidworksApi macros