VBA Exiting a Subroutine

I have a macro that scans a model and will detach any reference files that are live nested, missing and turned off. Essentially I only want reference models that belong to the file to remain.

This works fine until there are no references left to detach and I get the below error. How do I exit the subroutine?

Sub nestedRef()
    Dim currentRef As Attachment
    Dim refAttachments As Attachments
    Set refAttachments = ActiveModelReference.Attachments
        For Each currentRef In refAttachments
            Debug.Print currentRef.AttachName
            If Not currentRef.ElementsVisible Then
                refAttachments.Remove currentRef
            End If
            If currentRef.NestLevel > 0 _
            Or _
            currentRef.IsMissingFile Then
                refAttachments.Remove currentRef
            End If

        Next
End Sub

Parents
  • I only want reference models that belong to the file to remain

    Reference attachments belong to a DGN model, not to a file.

    An attachment may itself have attachments.  From the point of view of that attachment, its attachments are direct.  From the point of view of the top-level model, those are nested attachments.  Since an attached model is read-only, you can't directly affect nested attachments.

    Enumerate the attachments of a DGN model.  Remove those that meet your criteria.  I, like Jan, am a little confused about your criteria for removal.  Write a function that encapsulates your removal logic...

    Function IsCandidateForDetach (ByVal oAttachment As Attachment) As Boolean
      IsCandidateForDetach = False
      Debug.Print oAttachment.AttachName
      If oAttachment.IsMissingFile Then 
        IsCandidateForDetach = True
      ElseIf oAttachment.IsMissingModel Then
        IsCandidateForDetach = True
      ElseIf Not oAttachment.ElementsVisible Then
        IsCandidateForDetach = True
      End If
    End Function

     
    Regards, Jon Summers
    LA Solutions

  • I only want to retain Attachments that are visible and have No Nesting. Having a criteria of NestLevel > 0 gives me access to those that are live nested. Is there another way to achieve this?

    Thanks Jon your function works great though I just added a line for the attachments that have the Nested Attachment set to Live Nesting. However I assume I am not iterating over the function correctly in my For Each statement. How do I handle when there are no more Attachments that match the criteria?

        Dim currentRef As Attachment
        Dim refAttachments As Attachments
    Sub detachRefFile()
        Set refAttachments = ActiveModelReference.Attachments
        For Each currentRef In refAttachments
            If IsCandidateForDetach(currentRef) = True Then
                ActiveModelReference.Attachments.Remove currentRef
        End If
        Debug.Print currentRef & AttachModelName
    Next
    RedrawAllViews
    End Sub
    Function IsCandidateForDetach(ByVal oAttachment As Attachment) As Boolean
        IsCandidateForDetach = False
        Debug.Print oAttachment.AttachName
        If oAttachment.IsMissingFile Then
            IsCandidateForDetach = True
        ElseIf oAttachment.IsMissingModel Then
            IsCandidateForDetach = True
        ElseIf Not oAttachment.ElementsVisible Then
            IsCandidateForDetach = True
        ElseIf oAttachment.NestLevel > 0 Then
            IsCandidateForDetach = True
        End If
    End Function

  • Hi Simon,

    I only want to retain Attachments that are visible and have No Nesting.

    Ok, now it makes sense. "have no nesting" is completely different from original "are live nested". "Have no nesting" is a feture of an attachment of current level, whereas "are live nested" describes references at least one level below under current level (and it requires different code to be handled).

    However I assume I am not iterating over the function correctly in my For Each statement.

    Why do you assume it? Is there any error message? Do you have any test case where the code does not work correctly?

    For each loop always iterate a whole collection, unless an early escape is used (which is not the discussed case). As I wrote earlier, I am not sure whether it's allowed to delete the collection member, but in such case I guess the code will crash.

    With regards,

      Jan

  • A couple of bad styles and bugs found in your code, my modified version is:

    Option Explicit
    ' It's bad style to declare variables outside a scope where they will be used.
    ' Alwyas declare variable at the same place where it will be used for the first time,
    ' but not earlier.
    
    Sub detachRefFile()
        Dim refAttachments As Attachments
        Set refAttachments = ActiveModelReference.Attachments
        
        Dim currentRef As Attachment
        For Each currentRef In refAttachments
            If IsCandidateForDetach(currentRef) = True Then
                ' Two bugs were here:
                ' - Using & makes no sense, it's not valid VBA code
                ' - When the attachment is removed, it has not been valid anymore, so to use it later causes error
                Debug.Print currentRef.AttachModelName
                
                ActiveModelReference.Attachments.Remove currentRef
            End If
        Next
        
        RedrawAllViews ' MicroStation redraws views automatically, so redraw is not needed
    End Sub
    
    Function IsCandidateForDetach(ByVal oAttachment As Attachment) As Boolean
        IsCandidateForDetach = False
        Debug.Print oAttachment.AttachName
        If oAttachment.IsMissingFile Then
            IsCandidateForDetach = True
        ElseIf oAttachment.IsMissingModel Then
            IsCandidateForDetach = True
        ' Are you aware of all conditions hidden in this property?
        ' ElementsVisible marge both display off, frozen level and others.
        ElseIf Not oAttachment.ElementsVisible Then
            IsCandidateForDetach = True
        ElseIf oAttachment.NestLevel > 0 Then
            IsCandidateForDetach = True
        End If
        
    End Function
    

    Regards,

      Jan

    Answer Verified By: Robert Hook 

  • Hi Jan

    Thankyou for looking at this for me and ironing at the bugs, the code is working great. 

Reply Children
No Data