tradon/notes/accounting/excel_api/GLAccountsExcelApi.bas

Attribute VB_Name = "GLAccountsExcelApi"
Option Explicit

' 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 (or use a named DSN).
'
' Usage:
'   - On the Setup sheet, fill in B6 (company), B7 (account), B8 (currency), B9 (date).
'   - Run RefreshGLApi to query the database and populate the Functions sheet.
'   - Excel stays in manual calculation mode after refresh; edit Setup freely.
'
' DSN example:
'   "DSN=TradonGLApi;Uid=tradon_readonly;Pwd=change_me;"

Private Const GL_API_CONNECTION_STRING As String = _
    "Driver={PostgreSQL Unicode(x64)};" & _
    "Server=vps107.geneva.hosting;" & _
    "Port=5432;" & _
    "Database=tradon;" & _
    "Uid=postgres;" & _
    "Pwd=dsproject;"

Private gConnection As Object
Private gCache As Object
Private gApiEnabled As Boolean

' ---- Connection helpers ----

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.ConnectionTimeout = 5
        gConnection.CommandTimeout = 30
        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

' ---- Main macro ----

' Reads Setup!B6:B9, queries the database directly, writes plain values to Functions!C6:C13.
' Excel stays in xlCalculationManual after this runs -- edit Setup cells freely,
' then run RefreshGLApi again when you want fresh results.
Public Sub RefreshGLApi()
    Dim wsSetup As Worksheet
    Dim wsFunctions As Worksheet

    On Error Resume Next
    Set wsSetup = ThisWorkbook.Worksheets("Setup")
    Set wsFunctions = ThisWorkbook.Worksheets("Functions")
    On Error GoTo 0

    If wsSetup Is Nothing Then
        MsgBox "Sheet 'Setup' not found.", vbExclamation
        Exit Sub
    End If
    If wsFunctions Is Nothing Then
        MsgBox "Sheet 'Functions' not found.", vbExclamation
        Exit Sub
    End If

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim company As String
    Dim account As String
    Dim currency As String
    Dim valueDate As Variant

    company = CStr(wsSetup.Range("B6").Value)
    account = CStr(wsSetup.Range("B7").Value)
    currency = CStr(wsSetup.Range("B8").Value)
    valueDate = wsSetup.Range("B9").Value

    ClearGLApiCache

    On Error GoTo RefreshError

    wsFunctions.Range("C6").Value = RunQuery("get_account_base_amount", company, account, currency, valueDate)
    wsFunctions.Range("C7").Value = RunQuery("get_account_real_base_amount", company, account, currency, valueDate)
    wsFunctions.Range("C8").Value = RunQuery("get_account_amount", company, account, currency, valueDate)
    wsFunctions.Range("C9").Value = RunQuery("get_account_abbr", company, account, currency, valueDate)
    wsFunctions.Range("C10").Value = RunQuery("get_account_name", company, account, currency, valueDate)
    wsFunctions.Range("C11").Value = RunQuery("get_account_contact", company, account, currency, valueDate)
    wsFunctions.Range("C12").Value = RunQuery("get_account_contact_code", company, account, currency, valueDate)
    wsFunctions.Range("C13").Value = RunQuery("get_account_contact_name", company, account, currency, valueDate)

    CloseGLApiConnection
    GoTo RefreshDone

RefreshError:
    MsgBox "RefreshGLApi error: " & Err.Description, vbExclamation

RefreshDone:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    ' Intentionally keep xlCalculationManual -- prevents any live recalculation.
End Sub

' Resets Functions!C6:C13 to placeholder text.
Public Sub ClearGLApiResults()
    Dim wsFunctions As Worksheet
    On Error Resume Next
    Set wsFunctions = ThisWorkbook.Worksheets("Functions")
    On Error GoTo 0
    If wsFunctions Is Nothing Then Exit Sub

    Application.EnableEvents = False
    Dim r As Long
    For r = 6 To 13
        wsFunctions.Cells(r, 3).Value = "-"
    Next r
    Application.EnableEvents = True
End Sub

' ---- Core SQL runner ----

Private Function RunQuery( _
        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
        RunQuery = 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
        RunQuery = Empty
    Else
        RunQuery = rs.Fields(0).Value
    End If
    rs.Close

    ApiCache.Add key, RunQuery
    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
    RunQuery = "#ERR " & Err.Number & ": " & Err.Description
End Function

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

' ---- UDF functions (optional, for manual formula use) ----
'
' These functions are NOT called by RefreshGLApi.
' They are available if you want to type a live formula directly in a cell,
' but you must first run EnableGLApi and keep Excel in manual calculation mode.
' Warning: live UDF formulas in cells can freeze Excel on recalculation.

Public Sub EnableGLApi()
    gApiEnabled = True
    Application.Calculation = xlCalculationManual
End Sub

Public Sub DisableGLApi()
    gApiEnabled = False
    CloseGLApiConnection
End Sub

Public Function GetAccountBaseAmount( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    If Not gApiEnabled Then GetAccountBaseAmount = "#GLAPI_OFF": Exit Function
    GetAccountBaseAmount = RunQuery("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
    If Not gApiEnabled Then GetAccountRealBaseAmount = "#GLAPI_OFF": Exit Function
    GetAccountRealBaseAmount = RunQuery("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
    If Not gApiEnabled Then GetAccountAmount = "#GLAPI_OFF": Exit Function
    GetAccountAmount = RunQuery("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
    If Not gApiEnabled Then GetAccountAbbr = "#GLAPI_OFF": Exit Function
    GetAccountAbbr = RunQuery("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
    If Not gApiEnabled Then GetAccountName = "#GLAPI_OFF": Exit Function
    GetAccountName = RunQuery("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
    If Not gApiEnabled Then GetAccountContact = "#GLAPI_OFF": Exit Function
    GetAccountContact = RunQuery("get_account_contact", companyKey, accountCode, currencyIso, valueDate)
End Function

Public Function GetAccountContactCode( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    If Not gApiEnabled Then GetAccountContactCode = "#GLAPI_OFF": Exit Function
    GetAccountContactCode = RunQuery("get_account_contact_code", companyKey, accountCode, currencyIso, valueDate)
End Function

Public Function GetAccountContactName( _
        ByVal companyKey As Variant, _
        ByVal accountCode As Variant, _
        ByVal currencyIso As Variant, _
        ByVal valueDate As Variant) As Variant
    If Not gApiEnabled Then GetAccountContactName = "#GLAPI_OFF": Exit Function
    GetAccountContactName = RunQuery("get_account_contact_name", companyKey, accountCode, currencyIso, valueDate)
End Function