Dynamics GP - Modifier and VBA Visual Basic ODBC connection- Update multiple fields on navigation

• Before starting, ensure you check this
• Tools > References > Check the checkbox in front of "Microsoft ActiveX Data Objects 2.5 Library"

'---------------------------------------------------------------------------------------------------

Option Explicit




Private Function GetCurrCost() As String

    Dim cn As New ADODB.Connection

    Dim rst As New ADODB.Recordset

    Dim cmd As New ADODB.Command

    Dim SqlStr As String
    Dim TheCost As Currency, ThePrice As Currency
 



    On Error GoTo GetCurrCost_Err



    '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



    SqlStr = ""

    'Create a command to select result

    cmd.ActiveConnection = cn

    cmd.CommandType = adCmdText

    'Get Current Cost
    SqlStr = " select top 1 CURRCOST from dbo.IV00101 where ITEMNMBR = '" + ItemNumber + "'"

    cmd.CommandText = SqlStr

    Set rst = cmd.Execute



    'Display the rows retrieved

'    MsgBox ">>" + rst!ResultText

    TheCost = rst!CURRCOST

 '--------------------------------------------------------------------
    'Get BasePrice
    SqlStr = " select top 1 Price from dbo.BI_ExtPrc_BasePrices where ITEMNMBR = '" + ItemNumber
    SqlStr = SqlStr + "' and UofM = '" + BaseUofM + "'"

    cmd.CommandText = SqlStr

    Set rst = cmd.Execute
    ThePrice = rst!Price
 
'Close connection
    cn.Close
 
'Write results
    StringM18 = TheCost
    StringM17 = ThePrice

Exit Function



GetCurrCost_Err:



    Select Case Err.Number

    Case 91

        'Object variable or With block variable not set (Error 91)

        'MsgBox "Error 91:" + Str(Err.Number) + "<" + Err.Description + ">"

        Resume

    Case Else

        'MsgBox "Unknown Error:" + Str(Err.Number) + "<" + Err.Description + ">"

        Exit Function

    End Select



End Function

Private Function GetBasePrice() As String

    Dim cn As New ADODB.Connection

    Dim rst As New ADODB.Recordset

    Dim cmd As New ADODB.Command

    Dim SqlStr



    On Error GoTo GetBasePrice_Err



    '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



    SqlStr = ""

    '--------------------------------------------------------------------
    'Get BasePrice
    SqlStr = " select top 1 Price from dbo.BI_ExtPrc_BasePrices where (ITEMNMBR = '" + ItemNumber
    SqlStr = SqlStr + "') and UofM = ('" + BaseUofM + "')"

    cmd.CommandText = SqlStr

    Set rst = cmd.Execute



    'Display the rows retrieved

'    MsgBox ">>" + rst!ResultText

    StringM17 = rst!Price


    'Close the connection

    cn.Close

Exit Function



GetBasePrice_Err:



    Select Case Err.Number

    Case 91

        'Object variable or With block variable not set (Error 91)

        'MsgBox "Error 91:" + Str(Err.Number) + "<" + Err.Description + ">"

        Resume

    Case Else

        'MsgBox "Unknown Error:" + Str(Err.Number) + "<" + Err.Description + ">"

        Exit Function

    End Select
End Function


Private Function GETRunningUser(ByVal request As String) As String

    Dim UserInfoObj As UserInfo



    Dim CompanyName As String

    Dim IntercompanyID As String

    Dim SystemDatabase As String

    Dim UserDate As Date

    Dim UserID As String

    Dim UserName As String



    'Get the UserInfo object

    Set UserInfoObj = VbaGlobal.UserInfoGet()



    'Retrieve and display the UserInfo

    Select Case request

       Case "CompanyName"

            GETRunningUser = UserInfoObj.CompanyName

       Case "IntercompanyID"

            GETRunningUser = UserInfoObj.IntercompanyID

       Case "SystemDatabaseName"

            GETRunningUser = UserInfoObj.SystemDatabaseName

       Case "UserDate"

            GETRunningUser = UserInfoObj.UserDate

       Case "UserID"

            GETRunningUser = UserInfoObj.UserID

       Case "UserName"

            GETRunningUser = UserInfoObj.UserName

      Case Else

            GETRunningUser = ""

    End Select



End Function
Private Sub UpdateScreen()
StringM17 = 0
StringM18 = 0
If ItemNumber > "" Then
    GetCurrCost
End If
End Sub

Private Sub EndofFileButtonToolbar_AfterUserChanged()
UpdateScreen
End Sub

Private Sub ItemNumber_Changed()
UpdateScreen
End Sub

Private Sub NextButtonToolbar_AfterUserChanged()
UpdateScreen
End Sub

Private Sub PreviousButtonToolbar_AfterUserChanged()
UpdateScreen
End Sub
Private Sub TopofFileButtonToolbar_AfterUserChanged()
UpdateScreen
End Sub
Private Sub Window_BeforeOpen(OpenVisible As Boolean)

End Sub