tradon/notes/accounting/excel_api/GLAccountsExcelApi.bas

Attribute VB_Name = "GLAccountsExcelApi"
Option Explicit

' Finaccount-like Excel API POC for GL ACCOUNTS FUNCTIONS.
'
' Setup:
'   1. Install PostgreSQL ODBC driver.
'   2. Apply notes/accounting/excel_api/gl_accounts_sql_poc.sql.
'   3. In Excel: Developer > Visual Basic > File > Import File...
'   4. Import this .bas module.
'   5. Edit GL_API_CONNECTION_STRING below.
'
' Example:
'   =GetAccountAmount("COMPANY01","400000","USD",DATE(2026,5,31))

Private Const GL_API_CONNECTION_STRING As String = _
    "Driver={PostgreSQL Unicode(x64)};" & _
    "Server=localhost;" & _
    "Port=5432;" & _
    "Database=tradon;" & _
    "Uid=tradon_readonly;" & _
    "Pwd=change_me;"

Private gConnection As Object
Private gCache As Object

Private Function ApiCache() As Object
    If gCache Is Nothing Then
        Set gCache = CreateObject("Scripting.Dictionary")
    End If
    Set ApiCache = gCache
End Function

Private Function DbConnection() As Object
    If gConnection Is Nothing Then
        Set gConnection = CreateObject("ADODB.Connection")
        gConnection.ConnectionString = GL_API_CONNECTION_STRING
        gConnection.Open
    ElseIf gConnection.State = 0 Then
        gConnection.Open
    End If
    Set DbConnection = gConnection
End Function

Private Sub ResetDbConnection()
    On Error Resume Next
    If Not gConnection Is Nothing Then
        If gConnection.State <> 0 Then gConnection.Close
    End If
    Set gConnection = Nothing
    On Error GoTo 0
End Sub

Public Sub ClearGLApiCache()
    If Not gCache Is Nothing Then gCache.RemoveAll
End Sub

Public Sub CloseGLApiConnection()
    If Not gConnection Is Nothing Then
        If gConnection.State <> 0 Then gConnection.Close
    End If
    Set gConnection = Nothing
End Sub

Private Function SqlDate(ByVal valueDate As Variant) As String
    SqlDate = Format$(CDate(valueDate), "yyyy-mm-dd")
End Function

Private Function SqlText(ByVal value As Variant) As String
    SqlText = Replace(CStr(value), "'", "''")
End Function

Private Function QueryScalar( _
        ByVal functionName As String, _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant

    On Error GoTo ErrorHandler

    Dim key As String
    key = functionName & "|" & CStr(companyKey) & "|" & CStr(accountCode) _
        & "|" & CStr(currencyIso) & "|" & SqlDate(valueDate)

    If ApiCache.Exists(key) Then
        QueryScalar = ApiCache(key)
        Exit Function
    End If

    Dim sql As String
    sql = "select excel_api." & functionName & "('" _
        & SqlText(companyKey) & "','" _
        & SqlText(accountCode) & "','" _
        & SqlText(currencyIso) & "','" _
        & SqlDate(valueDate) & "'::date)"

    Dim rs As Object
    Dim attempt As Integer
RetryQuery:
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open sql, DbConnection, 0, 1

    If rs.EOF Or IsNull(rs.Fields(0).Value) Then
        QueryScalar = Empty
    Else
        QueryScalar = rs.Fields(0).Value
    End If
    rs.Close

    ApiCache.Add key, QueryScalar
    Exit Function

ErrorHandler:
    If attempt = 0 Then
        attempt = 1
        If Not rs Is Nothing Then
            If rs.State <> 0 Then rs.Close
        End If
        ResetDbConnection
        Resume RetryQuery
    End If
    QueryScalar = "#ERR " & Err.Number & ": " & Err.Description
End Function

Public Function GetAccountBaseAmount( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    GetAccountBaseAmount = QueryScalar("get_account_base_amount", _
        companyKey, accountCode, currencyIso, valueDate)
End Function

Public Function GetAccountRealBaseAmount( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    GetAccountRealBaseAmount = QueryScalar("get_account_real_base_amount", _
        companyKey, accountCode, currencyIso, valueDate)
End Function

Public Function GetAccountAmount( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    GetAccountAmount = QueryScalar("get_account_amount", _
        companyKey, accountCode, currencyIso, valueDate)
End Function

Public Function GetAccountAbbr( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    GetAccountAbbr = QueryScalar("get_account_abbr", _
        companyKey, accountCode, currencyIso, valueDate)
End Function

Public Function GetAccountName( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    GetAccountName = QueryScalar("get_account_name", _
        companyKey, accountCode, currencyIso, valueDate)
End Function

Public Function GetAccountContact( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    GetAccountContact = QueryScalar("get_account_contact", _
        companyKey, accountCode, currencyIso, valueDate)
End Function