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
    Matt Jones Sep 1, 2015 1:57 AM

      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