Go to matching

notes/accounting/excel_api/GLAccountsExcelApi.bas

@@ -0,0 +1,178 @@
+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