Dynamics GP - Modifier and VBA Visual Basic - ODBC Connection - GP2015 After 14.00.066

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

'---------------------------------------------------------------------------------------------------
Option Explicit

Private Sub CheckAccounts_BeforeUserChanged(KeepFocus As Boolean, CancelLogic As Boolean)
Dim RetVal As String
On Error GoTo CheckAccounts_BeforeUserChanged_Err

    Dim IntercompanyID As String
    Dim SystemDatabase As String
    Dim StockCountNumber As String
    Dim GetNOAccountResult As String
 
    'Retrieve and display the UserInfo
    IntercompanyID = GETRunningUser("IntercompanyID")
    SystemDatabase = GETRunningUser("SystemDatabaseName")

Exit Sub

Private Function GetNOAccount(ByVal coName As String, ByVal StockID As String) As String
    Dim cn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim cmd As New ADODB.Command
    Dim SqlStr As String

    On Error GoTo GetNOAccount_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
    cmd.CommandText = SqlStr
    Set rst = cmd.Execute

    SqlStr = " select top 1 * from dbo.ResultFile"
    cmd.CommandText = SqlStr
    Set rst = cmd.Execute

    'Display the rows retrieved
'rst![ColumnName]
'    MsgBox ">>" + rst!ResultText
    GetNOAccount = rst!ResultText
 
    'Close the connection
    cn.Close
Exit Function

GetNOAccount_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

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