macro which opens PO Entry screen with specific PO 2

[johnhugh]

Hello,

In Accpac 5.6, is it possible to write a macro which calls the PO entry screen?
For example I have a button on a form and after clicking it the PO entry screen opens with the PO I've selected in my macro?
Basically something like the drill down function Accpac has already.

How would I do that? Recording a macro while clicking the drill down button doesn't seem to record anything useful.

 

[ettienne]

Yes it is possible to open the PO screen (I do not have an example), recoding a macro will not do it since that records what happens with the views.

 

[ettienne]

I believe there is an example on the official Sage Accpac VBA forum

http://forums.sageaccpac.com/WEBFORUMS/ASPNETFORUMS/ShowForum.aspx?ForumID=20

 

[johnhugh]

Thanks ettienne. Would you please be able to copy it in here as I do not have a partner login?

 

[ettienne]

'---------------------------------------------------
' 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

 

[johnhugh]

Thank you.
I'll give that a go!