'---------------------------------------------------
' ObjectKey-Related Constants
'---------------------------------------------------
Private Const ParamMarker As String = vbLf
Private Const EqualMarker As String = "\eq"
Private Const EscMarker As String = "\\"
Sub MainSub()
Dim contPO1210 As AccpacContainerObject
Dim strArrKeys(1 To 1) As String
Dim strArrVals(1 To 1) As String
Dim strCLSID As String
Dim strCodebase As String
Dim strObjHandle As String
Dim strProcessorName As String
Dim strReturn As String
On Error GoTo ACCPACErrorHandler ' Set error handler
strArrKeys(1) = "KEY"
strArrVals(1) = 21774 'Change value to PORHSEQ of the PO you want to display
CreateObjectHandle _
"PO1210", _
KVBuildList(strArrKeys, strArrVals), _
strObjHandle, strCLSID, strCodebase
Set contPO1210 = New AccpacContainerObject
With contPO1210
.Init strCLSID, strCodebase, _
strObjHandle, ""
strReturn = .Show(0)
.Close
End With ' contUIProfiles
Set contPO1210 = Nothing ' no longer needed
Exit Sub
ACCPACErrorHandler:
Dim lCount As Long
Dim lIndex As Long
If Errors Is Nothing Then
MsgBox Err.Description
Else
lCount = Errors.Count
If lCount = 0 Then
MsgBox Err.Description
Else
For lIndex = 0 To lCount - 1
MsgBox Errors.Item(lIndex)
Next
Errors.Clear
End If
Resume Next
End If
End Sub
'---------------------------------------------------
' ObjectKey Parameter Utility Methods
'---------------------------------------------------
' This function builds a standard ObjectKey string
' from an array of key (parameter name) strings
' (strArrKey) and an array of associated value
' strings (strArrVals). ALL CALLERS that pass
' parameters (i.e. key/value pairs) to other UI's
' should call this function to package the
' parameters properly.
' NOTE: The array bounds (upper/lower) MUST match.
' (i.e. We CAN'T have one array being 0-based
' while the other is 1-based.)
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
'---------------------------------------------------
' 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
