Hey guys..

The macro Saves all open drawings as a pdf in to a folder called "PDF" that it creates (if the folder doesnt exist) in the directory the open document is in, then closes the drawing.

I have been testing it on other projects to see how well it goes and now it just keeps saving pretty much an PDF it creates back in to the first directory it creates from the first drawing I PDF. It seems to do this until I reset my computer!

Do I need to reset or clear some values during this macro??

Also some people in my office have their file extensions hidden and some people have them shown.. is there anyway to combat this in the one macro or do I just have to tweak it for every person? Currently for the ones not showing the extensions it subtracts 7 digits off the part number instead of just subtracting off the .sldprt extension!

Thanks again for all your awsomeness

See macro code below.

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swCustProp As CustomPropertyManager
Dim valOut1 As String
Dim valOut2 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim ConfigName As String
Dim PartNo As String
Dim FullName As String
Dim nFileName As String
Dim swView As SldWorks.View
Dim PDFpath As String
Dim Filename As String
Dim currpath As String
Sub main()
    Dim swDocs As Variant
    Dim i As Integer
    Set swApp = Application.SldWorks
    swDocs = swApp.GetDocuments
    For i = 0 To UBound(swDocs)
        Set swModel = swDocs(i)
        If swModel.GetType = swDocDRAWING Then
    
        currpath = Left(Filename, InStrRev(Filename, "\"))
        Filename = Right(swModel.GetPathName, Len(swModel.GetPathName) - InStrRev(swModel.GetPathName, "\"))
        PDFpath = currpath & "PDF"
            Set swDraw = swModel
            Set swView = swDraw.GetFirstView
            Set swView = swView.GetNextView
            Set swModel = swView.ReferencedDocument
        
            currpath = Left(Filename, InStrRev(Filename, "\"))
            Filename = Right(swModel.GetPathName, Len(swModel.GetPathName) - InStrRev(swModel.GetPathName, "\"))
            PDFpath = currpath & "PDF"
        
                If (swModel.GetType = swDocPART) Then
                    Set swModel = swView.ReferencedDocument
                    Set swView = swDraw.GetFirstView
                    Set swView = swView.GetNextView
                    ConfigName = swView.ReferencedConfiguration
                    FullName = swModel.GetTitle
                    PartNo = Left(FullName, Len(FullName) - 7)
                      
  
                    Set swCustProp = swModel.Extension.CustomPropertyManager(ConfigName)
                        swCustProp.Get2 "Description", valOut1, resolvedValOut1
                        swCustProp.Get2 "Revision", valOut2, resolvedValOut2
                    
                    If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath
  
  
                    nFileName = PDFpath & "\" & PartNo & "-" & ConfigName & "-" & resolvedValOut2 & " " & resolvedValOut1
    
                    swDraw.SaveAs3 nFileName & ".PDF", 0, 0
  
                     
                    swApp.QuitDoc swDraw.GetPathName
  
                ElseIf (swModel.GetType = swDocASSEMBLY) Then
  
  
                    Set swView = swDraw.GetFirstView
                    Set swView = swView.GetNextView
                    Set swModel = swView.ReferencedDocument
                    ConfigName = swView.ReferencedConfiguration
                    FullName = swModel.GetTitle
                    PartNo = Left(FullName, Len(FullName) - 7)
                     
  
                    Set swCustProp = swModel.Extension.CustomPropertyManager("")
                        swCustProp.Get2 "Description", valOut1, resolvedValOut1
                        swCustProp.Get2 "Revision", valOut2, resolvedValOut2
                    
                    If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath
                           
                    nFileName = PDFpath & "\" & PartNo & "-" & resolvedValOut2 & " " & resolvedValOut1
  
                    swDraw.SaveAs3 nFileName & ".PDF", 0, 0
  
                    swApp.QuitDoc swDraw.GetPathName
                End If
        End If
    Next i
    MsgBox ("All open drawings saved as PDF!" & vbNewLine & vbNewLine & "That was too fast and too furious.")
   
End Sub