10 Replies Latest reply on Mar 22, 2015 4:10 AM by Deepak Gupta

    Macro Question - Batch Save PDFs

    Mike Libbey

      The macro is to open all drawings for the active assembly (sub-assemblies and parts) and save them as individual PDFs.  However, the macro doesn't work.  Here is the code (which needs to run on a SW 2014, 64-bit system):


      Any help would be greatly appreciated!




      ' Description:

      ' Traverses the open assembly and activates all components and their drawings (if of the

      ' same name).


      Sub ShowAllOpenFiles()

      Dim swDoc As SldWorks.ModelDoc2

      Dim swAllDocs As EnumDocuments2

      Dim FirstDoc As SldWorks.ModelDoc2

      Dim dummy As Boolean

      Dim NumDocsReturned As Long

      Dim DocCount As Long

      Dim i As Long

      Dim sMsg As String

      Dim swApp As SldWorks.SldWorks

      Dim bDocWasVisible As Boolean

      Dim OpenWarnings As Long

      Dim OpenErrors As Long

      Dim DwgPath As String

      Dim myDwgDoc As SldWorks.ModelDoc2

      Dim drwPathName As String

      Dim pdfPathName As String

      Dim pdfFolderName As String


      Set swApp = Application.SldWorks

      Set swAllDocs = swApp.EnumDocuments2

      Set FirstDoc = swApp.ActiveDoc


      DocCount = 0


      swAllDocs.Next 1, swDoc, NumDocsReturned

      While NumDocsReturned <> 0

          bDocWasVisible = swDoc.Visible

          'swApp.ActivateDoc swDoc.GetPathName'

          DwgPath = swDoc.GetPathName

          If (LCase(Right(DwgPath, 3)) <> "drw") And (DwgPath <> "") Then

              DwgPath = Left(DwgPath, Len(DwgPath) - 3) & "drw"

              Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)

              If Not myDwgDoc Is Nothing Then

                  swApp.ActivateDoc myDwgDoc.GetPathName


      pdfFolderName = "C:\pdf files\"


      Dim fso As Scripting.FileSystemObject

      Set fso = CreateObject("Scripting.FileSystemObject")


      If (Not fso.FolderExists(pdfFolderName)) Then

      MsgBox (pdfFolderName + " does not exist")

      Exit Sub

      End If


      Dim Part As ModelDoc2

      Set Part = swApp.ActiveDoc()


      'You have a drawing active

      drwPathName = Part.GetPathName()


      If ("" = drwPathName) Then

      ' GetPathName() was empty

      MsgBox ("This drawing has not been saved yet")

      Exit Sub

      End If


      pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) + ".pdf")


      Part.SaveAs2 pdfPathName, 0, True, False


      'MsgBox ("PDF file was created")

          swApp.QuitDoc (Part.GetTitle)

                  Set myDwgDoc = Nothing

              End If

          End If

          swAllDocs.Next 1, swDoc, NumDocsReturned

          DocCount = DocCount + 1



      swApp.ActivateDoc FirstDoc.GetPathName


      End Sub