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
Remove this line
Move these lines (in bold) to top under Path = Path + "\"
Add these lines (in bold) after Set swApp = Application.SldWorks in case you do not want the PDFs to open up after save.
Edit: It should be False for not opening the PDF.