Open OE Entry with macro

[johnhugh]

Hi,

Is it possible to open the OE entry screen with a specific Order from within a macro in Accpac 5.5?
I tried recording a macro while openening order entry but the code it recorded does not seem to have anything to do with opening the actual screen.

 

[Jay Converse]

1. Add a form
2. Drop the OE1100 OCX on the form
3. Dim WithEvents dsOrder As AccpacOE1100.ACCPACDSControl
4. On the Form Load event, set the order you want in DSOrder

 

[DjangMan]

Sub ShowOrder(aORDUNIQ As String)

        Dim contOE1100 As AccpacContainerObject
        Dim strArrKeys(1 To 2) As String
        Dim strArrVals(1 To 2) As String
        Dim strCLSID As String
        Dim strCodebase As String
        Dim strObjHandle As String
        Dim strProcessorName As String
        Dim strReturn As String
        
        strArrKeys(1) = "INQUIRYMODE"
        strArrVals(1) = "1"
        strArrKeys(2) = "KEY"
        strArrVals(2) = aORDUNIQ
        
        
        frmMain.ACCPACUI.UISession.CreateObjectHandle _
            "OE1100", _
            KVBuildList(strArrKeys, strArrVals), _
            strObjHandle, strCLSID, strCodebase
        
        ' Show the UI modally (the return value will
        ' be the current profile ID for the UI when
        ' it is closed).
        Set contOE1100 = New AccpacContainerObject
        With contOE1100
            .Init strCLSID, strCodebase, _
                strObjHandle, ""
            strReturn = .Show(0)
            .Close
        End With  ' contUIProfiles
        Set contUIProfiles = Nothing  ' no longer needed
                    
    Err.Clear


End Sub

Public Function KVBuildList(strArrKeys() As String, _
                            strArrVals() As String) _
                           As String
On Error Resume Next
    Dim lKeysLBound As Long
    Dim lKeysUBound As Long
    Dim lValsLBound As Long
    Dim lValsUBound As Long
    Dim i As Long

    ' Retrieve the key (parameter) array's bounds.
    lKeysLBound = LBound(strArrKeys)
    lKeysUBound = UBound(strArrKeys)
    
    If Err.Number <> 0 Then
        ' The UI programmer put in an emtpy array of
        ' keys, so print a debug message and force a
        ' breakpoint to help diagnosis.  Return an
        ' empty string, clear errors, and GET OUT of
        ' the function.
        Debug.Print "KVBuildList error: strArrKeys " _
            & "is empty."
        Debug.Assert False  ' press F5 or F8 to continue
        
        KVBuildList = ""
        Err.Clear
        Exit Function
    End If
    
    ' IF WE GOT TO HERE, WE HAVE A NON-EMPTY ARRAY
    ' OF KEYS.
    
    ' Retrieve the value array's bounds.
    lValsLBound = LBound(strArrVals)
    lValsUBound = UBound(strArrVals)
    
    If Err.Number <> 0 Then
        ' The UI programmer put in an empty array of
        ' values, so print a debug message and force
        ' a breakpoint to help diagnosis.  Return an
        ' empty string, clear errors, and GET OUT of
        ' the function.
        Debug.Print "KVBuildList error: strArrVals " _
            & "is empty."
        Debug.Assert False  ' press F5 or F8 to continue
        
        KVBuildList = ""
        Err.Clear
        Exit Function
    End If
    
    ' IF WE GOT TO HERE, WE HAVE A NON-EMPTY ARRAY
    ' OF VALUES.
    
    ' Make sure the array bounds match.
    If (lKeysLBound <> lValsLBound) _
      Or (lKeysUBound <> lValsUBound) _
      Then
        ' The two arrays don't have matching bounds,
        ' so print a debug message and force a
        ' breakpoint to help diagnosis.  Return an
        ' empty string, clear errors, and GET OUT of
        ' the function.
        Debug.Print "KVBuildList error: The array " _
            & "bounds for strArrKeys and strArrVals" _
            & " don't match."
        Debug.Assert False  ' press F5 or F8 to continue
        
        KVBuildList = ""
        Err.Clear
        Exit Function
    End If
    
    ' IF WE GOT TO HERE, THE ARRAY BOUNDS MATCH.
    
    ' Build up the string, one parameter at a time.
    KVBuildList = ""  ' default value
    For i = lKeysLBound To lKeysUBound
        KVBuildList = KVBuildList & _
            CreatePropertyString(strArrKeys(i), _
                                 strArrVals(i))
    Next i
    
    Err.Clear
End Function

' This function retrieves the value (into the
' strValue "ByRef" argument) associated with the key
' (parameter) named strKey from a string
' (strKeyValList) that contains key (parameter name)
' and value pairs.  The list of parameters should
' have been packaged by the other UI's into standard
' ObjectKey format (using the KVBuildList function).
' ALL RECEIVERS that receive standard ObjectKey
' strings from caller UI's should use this function
' for each parameter they want to retrieve.  The
' return value indicates whether or not the key was
' found (as strValue will be "" if the key wasn't
' found or if the value connected to that (valid)
' key happens to be "").
Public Function KVGetValue(ByVal strKeyValList As String, _
                           ByVal strkey As String, _
                           ByRef strValue As String) _
                          As Boolean
On Error Resume Next
    Dim iOffset1 As Integer    ' where the <key> is in the strKeyValList string
    Dim iOffset2 As Integer    ' where the <value> is in the strKeyValList string
    Dim lKeyLen As Long
    
    strValue = ""  ' until set otherwise
    
    ' Make sure the key isn't empty.
    If (strkey = "") Then
        ' The key (to search on) is empty, so print
        ' a debug message and force a breakpoint to
        ' help diagnosis.  Indicate "key not found",
        ' clear errors, and GET OUT of the function.
        Debug.Print "KVBuildList error: strKey is " _
            & "empty."
        Debug.Assert False
        
        KVGetValue = False
        Err.Clear
        Exit Function
    End If
    
    ' IF WE GOT TO HERE, WE'RE SEARCHING ON A NON-
    ' EMPTY KEY.
    
    ' Look for the "<key>=" string in the list.
    strkey = EscapeParam(strkey) & "="
    lKeyLen = Len(strkey)
    iOffset2 = StrComp(Left(strKeyValList, lKeyLen), _
                       strkey, vbBinaryCompare)
    If Err.Number <> 0 Then
        ' One of the strings is Null (error setting
        ' integer iOffset2), so print a debug
        ' message and force a breakpoint to help
        ' diagnosis.  Indicate "key not found",
        ' clear errors, and GET OUT of the function.
        Debug.Print "KVBuildList error: " & _
            "strKeyValList and/or strKey is Null."
        Debug.Assert False
        
        KVGetValue = False
        Err.Clear
        Exit Function
    End If
    
    ' IF WE GOT TO HERE, NONE OF THE ARGUMENTS ARE
    ' NULL.
    
    If iOffset2 = 0 Then
        ' It is the first key. Found it.
        iOffset1 = 1     ' Offset = 1
    Else
        ' It is not the first key. Not found yet.
        strkey = ParamMarker & strkey
        lKeyLen = Len(strkey)
        iOffset1 = InStr(1, strKeyValList, _
                        strkey, vbBinaryCompare)
        If iOffset1 = 0 Then
            ' We didn't find the parameter at all.
            ' Just indicate that the key wasn't
            ' found and GET OUT of the function.
            ' NOTE: This isn't an "error".
            KVGetValue = False
            Exit Function
        End If
    End If
    
    ' IF WE GOT TO HERE, WE FOUND THE KEY.
    
    ' Indicate that we found the key and go to the
    ' start of the value associated with that key.
    KVGetValue = True
    iOffset1 = iOffset1 + lKeyLen

    ' Get the value.
    iOffset2 = InStr(iOffset1, strKeyValList, ParamMarker, vbBinaryCompare)
    If iOffset2 = 0 Then  ' Missing end marked
        strValue = UnescapeParam( _
                       Mid(strKeyValList, iOffset1))
    Else
        strValue = UnescapeParam( _
                    Mid(strKeyValList, iOffset1, _
                        iOffset2 - iOffset1))
    End If
End Function


'---------------------------------------------------
' Private Helpers for ObjectKey Parameter Methods
'---------------------------------------------------

' This function creates a "Name=Value" pair (along
' with the parameter separator) for a parameter,
' which will end up as part of the ObjectKey.
Private Function CreatePropertyString(ByVal strParamName As String, _
                      ByVal strParamValue As String) _
                     As String
On Error Resume Next
    CreatePropertyString = _
        EscapeParam(strParamName) & _
        "=" & _
        EscapeParam(strParamValue) & _
        ParamMarker
    
    Err.Clear
End Function

Private Function EscapeParam(ByVal strUnescaped As String) _
                            As String
On Error Resume Next
    EscapeParam = Replace(strUnescaped, "\", EscMarker, , , vbBinaryCompare)
    EscapeParam = Replace(EscapeParam, "=", EqualMarker, , , vbBinaryCompare)
    EscapeParam = Replace(EscapeParam, ParamMarker, "\0", , , vbBinaryCompare)
    
    Err.Clear
End Function

Private Function UnescapeParam(ByVal strEscaped As String) _
                              As String
On Error Resume Next
    Dim sPos As Integer
    Dim ePos As Integer
    
    UnescapeParam = ""  ' until told otherwise
    
    sPos = 1
    ePos = InStr(1, strEscaped, "\", vbBinaryCompare)
    While ePos > 0
        If StrComp(Mid(strEscaped, ePos, Len(EqualMarker)), EqualMarker, vbBinaryCompare) = 0 Then
            UnescapeParam = UnescapeParam & Mid(strEscaped, sPos, ePos - sPos) & "="
            ePos = ePos + Len(EqualMarker)
            sPos = ePos
        ElseIf StrComp(Mid(strEscaped, ePos, Len("\0")), "\0", vbBinaryCompare) = 0 Then
            UnescapeParam = UnescapeParam & Mid(strEscaped, sPos, ePos - sPos) & ParamMarker
            ePos = ePos + Len("\0")
            sPos = ePos
        ElseIf StrComp(Mid(strEscaped, ePos, Len(EscMarker)), EscMarker, vbBinaryCompare) = 0 Then
            UnescapeParam = UnescapeParam & Mid(strEscaped, sPos, ePos - sPos) & "\"
            ePos = ePos + Len(EscMarker)
            sPos = ePos
        Else
            ePos = ePos + 1  ' invalid escape character!  Ignore to be safe!
        End If
        ePos = InStr(ePos, strEscaped, "\", vbBinaryCompare)
    Wend
    UnescapeParam = UnescapeParam & Mid(strEscaped, sPos)
    
    Err.Clear
End Function

 

[johnhugh]

Thanks, I'll give that a try.