I am getting an error in my code that I can't seem to figure why. I will run the macro successfully once or twice (sometimes 3 or 4 times) and then when I try and run it again, I get an error, usually on the same line, but sometimes on a different line (but usually the lines are performing similar tasks).
The error, when I debug the program, occurs on line 103 (sometimes different lines that contain similar code). I notice that when I run the program, the filename string is empty (looks as "" when I mouse over it). I can't see why it would be empty as the program doesn't even open up a folder browser dialogue.
Any help in figuring this out with me would be much appreciated!
Option Explicit Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim status As Boolean Dim filename As String Dim swDraw As SldWorks.ModelDoc2 Dim swCustProp As SldWorks.CustomPropertyManager Dim swView As SldWorks.View Dim ValOut As String Dim Path As String Dim PDFpath As String Dim DXFpath As String Dim IGSpath As String Dim DWGpath As String Dim Rev As String Dim nErrors As Long Dim nWarnings As Long Dim swExportPDFData As SldWorks.ExportPdfData Sub main() On Error GoTo ErrCatcher Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc Set swView = swDraw.GetFirstView 'this is the sheet view Set swView = swView.GetNextView 'this is the next view (view 1 or not I am not sure need to test) Set swModel = swView.ReferencedDocument Set swCustProp = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration) 'swExportPDFData.ViewPdfAfterSaving = False If swModel Is Nothing Then MsgBox "Open a file first" Exit Sub End If Dim contFolder As String contFolder = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") - 1) 'Opens folder browser dialogue and prompts user for PDF Folder Path = SelectFolder("Select PDF Folder", contFolder) If Len(Path) Then Path = Path + "\" 'if user clicks okay, continues the program Else 'if user clicks cancel, exit the macro Exit Sub End If 'gets drawing number from model Set swCustProp = swModel.Extension.CustomPropertyManager("") swCustProp.Get5 "DrawingNo", True, ValOut, filename, False 'gets rev from drawing properties Rev = swDraw.CustomInfo("Revision") 'sets the filename to format: M*123456_REV-** filename = filename & "_REV-" & Rev If InStr(filename, "PEF") > 0 Then MsgBox "This is a PEF File " & InStr(filename, "PEF") savePEF Else Select Case swModel.GetType Case swDocPART MsgBox "part file" savePart Case swDocDRAWING 'Do nothing Case swDocASSEMBLY MsgBox "assembly file" saveAssy End Select End If ErrCatcher: If Err.Number > 0 Then MsgBox ("The error was " & Err.Number) Err.Clear End If On Error GoTo 0 End Sub Public Sub savePEF() 'creates the PDF directory if it doesn't exist PDFpath = Path & "PDFs\" If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath 'creates the DXF directory if it doesn't exist DXFpath = Path & "DXFs\" If Dir(DXFpath, vbDirectory) = "" Then MkDir DXFpath 'creates the DWG directory if it doesn't exist DWGpath = Path & "DWGs\" If Dir(DWGpath, vbDirectory) = "" Then MkDir DWGpath 'saves as PDF swDraw.SaveAs (PDFpath & filename & ".pdf") 'Saves as DXF swDraw.SaveAs (DXFpath & filename & ".dxf") 'Saves as DWG swDraw.SaveAs (DWGpath & filename & ".dwg") End Sub Public Sub saveAssy() 'creates the PDF directory if it doesn't exist PDFpath = Path & "PDFs\" If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath 'saves as PDF swDraw.SaveAs (PDFpath & filename & ".pdf") End Sub Public Sub savePart() 'creates the PDF directory if it doesn't exist PDFpath = Path & "PDFs\" If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath 'creates the DXF directory if it doesn't exist DXFpath = Path & "DXFs\" If Dir(DXFpath, vbDirectory) = "" Then MkDir DXFpath 'creates the IGS directory if it doesn't exist IGSpath = Path & "IGSs\" If Dir(IGSpath, vbDirectory) = "" Then MkDir IGSpath 'saves as PDF swDraw.SaveAs (PDFpath & filename & ".pdf") 'Saves as DXF swDraw.SaveAs (DXFpath & filename & ".dxf") 'Saves as IGES Set swModel = swApp.ActivateDoc3(swModel.GetPathName, False, swRebuildActiveDoc, nErrors) swModel.Visible = 0 swModel.Extension.SaveAs IGSpath & filename & ".igs", 0, 0, Nothing, nErrors, nWarnings 'closes the recently opened part file swApp.CloseDoc swModel.GetTitle End Sub 'Both arguements are optional. The first is the dialog caption and the second is is to specify the top-most visible folder in the hierarchy. The default is "My Computer." 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