40 Replies Latest reply on Apr 30, 2018 4:05 PM by Alexander Brown

    Macro Help: Open All Drawings In Folder and Save As PDF

    Matt Jones

      I have created a macro (thanks to finding code from one of Deepak's macros combined with one of mine) that is supposed to do the following;

       

      -Open a Folder Selection Box (where the user selects a folder)

      -Open all the drawing files in the selected folder (one by one, one after the other)

      -Check to see if there is a folder called "PDF" in the directory, if not then create one

      -Save the open drawing file as a pdf, building the save as name from custom properties in the referenced model

      -Close the drawing

      -Move on to next one

       

      Now in my code below (and I have attached the macro file because there is the browse folder module attached) the macro will complete one drawing, close the drawing and show the msgbox if that "PDF" folder exists, if the folder does not exist it will create the folder, save the open drawing, close the drawing and fail on "sFileName = Dir"

       

      If I comment out the "If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath" and make "pdfpath=currpath" it runs perfectly and saves the drawings all in the selected directory.

       

      Can anyone please help me solve this, so it creates that PDF folder and saves the PDFs in to it??

       

      Option Explicit
      
      Dim swApp        As SldWorks.SldWorks
      Dim swModel      As SldWorks.ModelDoc
      Dim sFileName    As String
      Dim vFileName    As String
      Dim Path         As String
      Dim nPath        As String
      Dim nErrors      As Long
      Dim nWarnings    As Long
      Dim swDraw       As SldWorks.DrawingDoc
      Dim swCustProp   As CustomPropertyManager
      Dim swView       As SldWorks.View
      Dim ConfigName   As String
      Dim i            As Long
      Dim valOut1      As String
      Dim valOut2      As String
      Dim resolvedValOut1 As String
      Dim resolvedValOut2 As String
      Dim PartNo      As String
      Dim nFileName      As String
      Dim swDocs As Variant
      Dim PDFpath As String
      Dim currpath As String
      Dim PartNoDes As String
        
      Sub main()
      
          Set swApp = Application.SldWorks
             
          Path = BrowseFolder("Select a Path/Folder")
          
          Path = Path + "\"
          
          sFileName = Dir(Path & "*.slddrw")
          
          
          Do Until sFileName = ""
      
      
              Set swModel = swApp.OpenDoc6(Path + sFileName, swDocDRAWING, swOpenDocOptions_Silent, "", nErrors, nWarnings)
      
      
              Set swModel = swApp.ActiveDoc
              Set swDraw = swApp.ActiveDoc
              Set swView = swDraw.GetFirstView
              Set swView = swView.GetNextView
              Set swModel = swView.ReferencedDocument
      
      
              currpath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
              PDFpath = currpath & "PDF"
          
              If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath
           
                
              If swModel.GetType = swDocPART Then
                  PartNoDes = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
                  PartNoDes = Right(PartNoDes, Len(PartNoDes) - 14)
                  PartNoDes = Left(PartNoDes, Len(PartNoDes) - 7)
                  PartNo = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
                  PartNo = Left(PartNo, Len(PartNo) - 7)
                  Set swCustProp = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)
                  ConfigName = swView.ReferencedConfiguration
                  swCustProp.Get2 "Description", valOut1, resolvedValOut1
                  swCustProp.Get2 "Revision", valOut2, resolvedValOut2
                  nFileName = PDFpath & "\" & PartNo & "-" & ConfigName & "-" & resolvedValOut2 & " " & PartNoDes
                  swDraw.SaveAs3 nFileName & ".PDF", 0, 0
                          
              ElseIf swModel.GetType = swDocASSEMBLY Then
                  PartNoDes = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
                  PartNoDes = Right(PartNoDes, Len(PartNoDes) - 11)
                  PartNoDes = Left(PartNoDes, Len(PartNoDes) - 7)
                  PartNo = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
                  PartNo = Left(PartNo, Len(PartNo) - 7)
                  Set swCustProp = swModel.Extension.CustomPropertyManager("")
                  swCustProp.Get2 "Description", valOut1, resolvedValOut1
                  swCustProp.Get2 "Revision", valOut2, resolvedValOut2
                  nFileName = PDFpath & "\" & PartNo & "-" & resolvedValOut2 & " " & PartNoDes
                  swDraw.SaveAs3 nFileName & ".PDF", 0, 0
                       
              End If
          
              swApp.QuitDoc swDraw.GetPathName
          
              Set swDraw = Nothing
           
              Set swModel = Nothing
           
              sFileName = Dir
         
          Loop
      
      
      MsgBox "All Done"
      
      
      End Sub