VBA Loop - Start with Active Document

[Anonymous]

I'm looking to run a loop to convert open parts and assemblies to step files. I currently have one module that will loop through all open documents converting them and another module to  convert only the active document. I'd like to have just a single module that based upon user input will either convert all or only the active document.

The way I started going about it was with a "For Each Next" Loop with an "If" statement near the end to "Exit For" if a msgbox result is No. This works great except that the "For Each Next" loop seems to start in alphabetical order and not with the Active Document. If the user selects "no" then I'd like to only convert the active document in inventor. Any help would be appreciated.

Public Sub STEP_ALL()
Dim ALLResult As VbMsgBoxResult
    'Display Yes and No Button
    ALLResult = MsgBox("Convert All Documents?", vbYesNo, "Question")
    ' Get the STEP translator Add-In.
    Dim oSTEPTranslator As TranslatorAddIn
    Set oSTEPTranslator = ThisApplication.ApplicationAddIns _
    .ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
    If oSTEPTranslator Is Nothing Then
      MsgBox "Could not access STEP translator."
      Exit Sub
    End If
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
    For Each oDoc In ThisApplication.Documents.VisibleDocuments
        oDoc.Activate
        Dim oContext As TranslationContext
        Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
        Dim oOptions As NameValueMap
        Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
        ' Get the active document.
        Dim invDoc As Document
        Set invDoc = ThisApplication.ActiveDocument
        ' Get the design tracking property set.
        Dim invDesignInfo As PropertySet
        Set invDesignInfo = invDoc.PropertySets.Item("Design Tracking Properties")
        ' Get the description property.
        Dim invDescriptionProperty As Property
        Set invDescriptionProperty = invDesignInfo.Item("Description")
        'MsgBox "Description: " & invDescriptionProperty.Value
        If oSTEPTranslator.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
            ' Set application protocol.
            'eAP203 = 2
            'eAP214IS = 4
            'eAP242 = 5
            oOptions.Value("ApplicationProtocolType") = 4
            ' False = No Sketches
            oOptions.Value("IncludeSketches") = False
            oOptions.Value("Description") = invDescriptionProperty.Value
            oContext.Type = kFileBrowseIOMechanism
            'make Step Directory
            If Dir("D:\EXPORT STEP", vbDirectory) = "" Then
                MkDir ("D:\EXPORT STEP")
            End If
            Dim filename As String
            filename = oDoc.DisplayName
            'Strip .ipt & .iam from filename.
            filename = Replace(filename, ".ipt", "", 1, -1, 1)
            filename = Replace(filename, ".iam", "", 1, -1, 1)
            Dim oData As DataMedium
            Set oData = ThisApplication.TransientObjects.CreateDataMedium
            oData.filename = "D:\EXPORT STEP\" & filename & ".stp"
            Call oSTEPTranslator.SaveCopyAs(invDoc, oContext, oOptions, oData)
            Shell ("\\ACE-FS01-115\mailboxes\MECH ENG SHARED\Autohotkey\VBAUSE.exe")
        End If
        If ALLResult = VbMsgBoxResult.vbNo Then
            Exit For
        End If
    Next
Beep
Dim msgResult As VbMsgBoxResult
'Display Yes and No Button
msgResult = MsgBox("Open the save location?", vbYesNo, "STEP Done")
If msgResult = VbMsgBoxResult.vbYes Then
    'User Clicked Yes
    Call Shell("explorer.exe " & "D:\EXPORT STEP\", vbNormalFocus)
Else
    'User Clicked No
End If
End Sub

[dgreatice · Accepted solution]

Hi,

you workflow seen strange for me,

why create statement "all document" then loop to all visible document with result statement is no?

you workflow my be calling another procedure.

1. ask statement

2. if yes then loop to all visible

3. if no then calling another procedure

public sub askstatement

if Yes then

call LoopToAllVisibleDoc

else

Call ProcessOnlyActiveDoc

end if

end sub

Public sub LoopToAllVisibleDoc

For Each Statement

End Sub

Public sub ProcessOnlyActiveDoc

...

End Sub