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