AnsweredAssumed Answered

Help with an error that I can't seem to find the cause of - run-time error 91

Question asked by William Miller on Apr 9, 2018
Latest reply on Apr 10, 2018 by Ivana Kolin

Hello all,

 

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

Outcomes