I am trying to write a macro to automatically take all open drawings and save them as PDF and DXF files. Right now I am currently working on assigning the filename to one of my custom properties but am having issues. My code is below. For some reason, it says that my property "DrawingNo" is empty. Any ideas what I am doing wrong?
Option Explicit Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim swModelDocExt As SldWorks.ModelDocExtension Dim swExportData As SldWorks.ExportPdfData Dim filename As String Dim swDraw As SldWorks.DrawingDoc Dim swFeat As SldWorks.Feature Dim swCustProp As SldWorks.CustomPropertyManager Dim swView As SldWorks.View Sub main() Set swApp = Application.SldWorks Dim Path As String Dim PDFpath As String Dim filename As String Dim Rev As String Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc Set swView = swDraw.GetFirstView Set swView = swView.GetNextView Set swModel = swView.ReferencedDocument Set swCustProp = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration) 'Opens folder browser dialogue and prompts user for PDF Folder Path = SelectFolder("Select PDF Folder", "C:\Users\USER\Desktop") Path = Path + "\" 'create the PDF directory if it doesn't exist PDFpath = Path & "PDF" If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath 'Saves as PDF Set swDraw = swModel filename = swCustProp.Get("DrawingNo") Rev = swDraw.CustomInfo("Revision") filename = filename & "_REV-" & Rev swDraw.SaveAs (PDFpath & filename & ".pdf") 'Saves as DXF End Sub Function SelectFolder(Optional Title As String, Optional TopFolder _ As String) As String Dim objShell As New Shell32.Shell Dim objFolder As Shell32.Folder 'If you use 16384 instead of 1 on the next line, 'files are also displayed Set objFolder = objShell.BrowseForFolder(0, Title, 1, TopFolder) If Not objFolder Is Nothing Then SelectFolder = objFolder.Items.Item.Path End If End Function