Tuesday, July 4, 2017

Dynamics GP Purchase Order Blank Form - Get Line Item Tax Amount

'Let all currency fields be text. VB does not populate the values into currency fields correctly.

'Global Declares
Option Explicit
'Connection objects
Dim cn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim cmd As New ADODB.Command
'
Dim UID As String
Dim sqlstring As String

Private Sub Report_BeforeAH(ByVal Level As Integer, SuppressBand As Boolean)
Dim z
On Error GoTo Report_BeforeBody_Error

    UID = UserInfoGet.UserID
    sqlstring = ""
    sqlstring = sqlstring & " SELECT TAXAMNT FROM POP10110 WHERE (PONUMBER = '" & PONumber & "') AND (ORD = " & Ord & ");"


    cmd.CommandType = adCmdText
    cmd.CommandText = sqlstring
    Set rst = cmd.Execute

    If Not (rst.EOF And rst.BOF) Then
'        UserID = rst!UserID
'        EMPLOYID = rst!EMPLOYID
        xVat = Format(rst!TaxAmnt, "$#,##0.00;($#,##0.00)")
'        xVat = rst!TaxAmnt
     
    End If

    Exit Sub

Report_BeforeBody_Error:
    MsgBox "Report_BeforeBody Error:>" + Str(Err)
    Select Case Err.Number
    Case 3704
        '  object closed
        z = ExecuteOpen
        Resume
    Case Else
        MsgBox "Unknown Error:" + Str(Err.Number) + "<" + Err.Description + ">"
        Exit Sub
    End Select
End Sub


Private Sub Report_BeforeRH(SuppressBand As Boolean)
Dim z
On Error GoTo Report_BeforeBody_Error

'---------------------------------------------------------------------------------------------------------
' Get Location Address Info
    UID = UserInfoGet.UserID
    sqlstring = ""
    sqlstring = sqlstring & " SELECT TOP 1 POP10110.PONUMBER, IV40700.ADDRESS1, IV40700.ADDRESS2, IV40700.ADDRESS3, IV40700.CITY, IV40700.STATE, IV40700.LOCNCODE, IV40700.LOCNDSCR"
    sqlstring = sqlstring & " FROM POP10110 INNER JOIN "
    sqlstring = sqlstring & " IV40700 ON POP10110.LOCNCODE = IV40700.LOCNCODE WHERE (POP10110.PONUMBER = '" & PONumber & "');"


    cmd.CommandType = adCmdText
    cmd.CommandText = sqlstring
    Set rst = cmd.Execute

    If Not (rst.EOF And rst.BOF) Then
'        UserID = rst!UserID
'        EMPLOYID = rst!EMPLOYID
'        xVat = Format(rst!TaxAmnt, "$#,##0.00;($#,##0.00)")
        xLocShipToAdd1 = rst!Address1
        xLocShipToAdd2 = rst!Address2
        xLocShipToAdd3 = rst!Address3
        xLocShipToAdd4 = rst!City
        xLocShipToAdd5 = rst!State
        xLocShipToSite = rst!Locncode
        xLocShipToSiteDesc = Trim(rst!Locncode) + " " + rst!Locndscr
     
    End If


    Exit Sub

Report_BeforeBody_Error:
    MsgBox "Report_BeforeBody Error:>" + Str(Err)
    Select Case Err.Number
    Case 3704
        '  object closed
        z = ExecuteOpen
        Resume
    Case Else
        MsgBox "Unknown Error:" + Str(Err.Number) + "<" + Err.Description + ">"
        Exit Sub
    End Select
End Sub


'
Private Sub Report_Start()
    Dim z
    z = ExecuteOpen

End Sub

'
Private Sub Report_End()
    Dim z
    z = ExecuteClose()

End Sub
'
Function ExecuteOpen() As Boolean
On Error GoTo ExecuteOpen_Error
    'Retrieve an ADO connection for the current user
    Set cn = UserInfoGet.CreateADOConnection()
    'Set the connection properties
    cn.CursorLocation = adUseClient
    'Set the current database, using the IntercompanyID property
    cn.DefaultDatabase = UserInfoGet.IntercompanyID
    'Create a command to select all records
    cmd.ActiveConnection = cn
    'report open status
    ExecuteOpen = True
    Exit Function
ExecuteOpen_Error:
    MsgBox "ExecuteOpen Error:>" + Str(Err)
    ExecuteOpen = False
    'Close the connection
    cn.Close
End Function
'
Function ExecuteClose() As Boolean
On Error GoTo ExecuteClose_Error
    'Close the recordset and connection objects
    If rst.State = adStateOpen Then rst.Close
    If cn.State = adStateOpen Then cn.Close
ExecuteClose_Error:
    Set rst = Nothing
    Set cn = Nothing
    Set cmd = Nothing
End Function

No comments:

Post a Comment