8 Replies Latest reply on Aug 21, 2016 12:25 AM by Deepak Gupta

    Save As PDF Macro, Not Save Certain Sheets

    Brennan Sheremeto

      Hi,

       

      I'm writing a save as PDF macro and I have it working properly except for I don't want it to save sheets named "DXF" in the PDF file. Here is the code I have (from another post on here) to strip out the PDFs with DXF in the name.

       

      'GET PDF DATA AND SAVE

      Set swExportPdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)

        

          ReDim strSheetName(0)

          Dim s As Variant

          For Each s In swDrawDoc.GetSheetNames

              If Not UCase(s) Like "*DXF*" Then

                  strSheetName(UBound(strSheetName)) = s

                  ReDim Preserve strSheetName(UBound(strSheetName) + 1)

              End If

          Next s

        

          varSheetName = strSheetName

          If swExportPdfData Is Nothing Then MsgBox "Nothing"

          boolstatus = swExportPdfData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)

        

      boolstatus = swModelDocExt.SaveAs(SavePath, 0, 0, swExportPdfData, lErrors, lWarnings)

       

      However the DXF sheet still gets saved.

        • Re: Save As PDF Macro, Not Save Certain Sheets
          Deepak Gupta

          It had worked fine for me. Can you share the full macro to debug?

            • Re: Save As PDF Macro, Not Save Certain Sheets
              Brennan Sheremeto

              Sure,

              Option Explicit

               

               

              Sub main()

               

               

              Dim swApp           As SldWorks.SldWorks

              Dim swModel         As SldWorks.ModelDoc2

              Dim swDrawDoc       As SldWorks.DrawingDoc

              Dim swModelDocExt   As SldWorks.ModelDocExtension

              Dim SWmoddoc        As SldWorks.ModelDoc2

              Dim swExportPdfData As Object

              Dim boolstatus      As Boolean

              Dim filename        As String

              Dim lErrors         As Long

              Dim lWarnings       As Long

              Dim strSheetName()  As String

              Dim varSheetName    As Variant

               

               

              Dim FilePath As String

              Dim PathSize As Long

              Dim PathNoExtension As String

              Dim PartNumber As String

              Dim NewFilePath As String

              Dim SavePath As String

              Dim Revision As String

              Dim PrevRevision As String

              Dim ObsoletePath As String

              Dim RevisionCode As Long

               

               

              Set swApp = Application.SldWorks

              swApp.Visible = True

              Set swModel = swApp.ActiveDoc

              Set swDrawDoc = swModel

              Set swModelDocExt = swModel.Extension

               

               

               

               

              'GET FILE NAME AND SAVE PATH LOCATION

              FilePath = swModel.GetPathName

              PathSize = Strings.Len(FilePath)

              PathNoExtension = Strings.Left(FilePath, PathSize - 7)

              PartNumber = Mid(PathNoExtension, Len(PathNoExtension) - InStr(1, StrReverse(PathNoExtension), "\") + 6)

               

               

              PathSize = Strings.Len(PartNumber)

               

               

              If PathSize = 4 Then

                  SavePath = FourDigitPart(PartNumber)

              ElseIf PathSize = 5 Then

                  SavePath = FiveDigitPart(PartNumber)

              ElseIf InStr(PartNumber, "-") = 5 Then

                  SavePath = FourDigitPart(PartNumber)

              ElseIf InStr(PartNumber, "-") = 6 Then

                  SavePath = FiveDigitPart(PartNumber)

              End If

               

               

              SavePath = SavePath & "\001-" & PartNumber & ".PDF"

               

               

              'COPY AND RENAME CURRENTLY SAVED PDF

              Set SWmoddoc = swApp.ActiveDoc

              Revision = SWmoddoc.CustomInfo("Revision")

              RevisionCode = Asc(Revision) - 1

              PrevRevision = Chr(RevisionCode)

              If RevisionCode = 64 Or RevisionCode = 96 Then

                  ObsoletePath = "\\SVR-FS2\Secondary File Storage\Production Drawings\KEEP OBSOLETE\001-" & PartNumber & "-OBSOLETE.PDF"

              Else

                  ObsoletePath = "\\SVR-FS2\Secondary File Storage\Production Drawings\KEEP OBSOLETE\001-" & PartNumber & "-" & PrevRevision & "-OBSOLETE.PDF"

              End If

               

               

              If Len(Dir(SavePath)) <> 0 And Len(Dir(ObsoletePath)) = 0 Then

                  FileCopy SavePath, ObsoletePath

              End If

               

               

               

               

              'GET PDF DATA AND SAVE

                  Set swExportPdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)

                

                  ReDim strSheetName(0)

                  Dim s As Variant

                  For Each s In swDrawDoc.GetSheetNames

                      If Not UCase(s) Like "*DXF*" Then

                          strSheetName(UBound(strSheetName)) = s

                          ReDim Preserve strSheetName(UBound(strSheetName) + 1)

                      End If

                  Next s

                

                  varSheetName = strSheetName

                  If swExportPdfData Is Nothing Then MsgBox "Nothing"

                  boolstatus = swExportPdfData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)

                

              boolstatus = swModelDocExt.SaveAs(SavePath, 0, 0, swExportPdfData, lErrors, lWarnings)

               

               

               

               

              End Sub