' ========================================================================= ' StockFunctions.bas ' Collabora / LibreOffice Basic port of the ONLYOFFICE custom functions. ' ' UPDATED 2026-07-27: FUNDTIME now returns Yahoo's last market update ' date and time as a combined Calc date/time value. ' ' FUNDPRICE returns the current price from stockproxy. ' FUNDPRICE_HIST returns a historical price from stockproxy. ' FUNDTIME returns Yahoo's regularMarketTime as a date/time value. ' ' Example FUNDTIME result: ' 2026-07-27 19:58:00 ' ' The returned value is a real Calc date/time value, not text, so it can ' be sorted, compared, formatted, or used in date/time calculations. ' ' HOW TO INSTALL IN COLLABORA: ' 1. Open the sheet in Collabora (collabora.kingdezigns.com). ' 2. Tools > Macros > Edit Macros (opens the Basic IDE). ' 3. In the tree, find "" (NOT "My Macros" - ' you want this stored IN the document so it travels with the file). ' 4. Right-click "Standard" under your document > Insert > Module. ' 5. Paste this entire file's contents into the new module. ' (Or, if StockFunctions already exists, replace its contents.) ' 6. Fill in PROXY_SECRET() below with the real value if not already set. ' 7. Save the document (Ctrl+S). Macro security must allow this ' document's macros to run - if prompted, allow them. ' ' USAGE IN CELLS: ' =FUNDPRICE(D4) ' =FUNDPRICE_HIST(D4, TEXT($B$3,"yyyy-mm-dd")) ' =FUNDPRICE(A5) <- replaces old =STOCKPRICE(A5) ' =FUNDTIME(A5) <- returns Yahoo date/time of latest market update ' ========================================================================= Option Explicit ' ---- Config ------------------------------------------------------------- Function PROXY_BASE() As String PROXY_BASE = "https://stocks.kingdezigns.com" End Function Function PROXY_SECRET() As String PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc" ' <-- from Vaultwarden End Function ' ---- Public spreadsheet functions --------------------------------------- Function FUNDPRICE(ticker As String) As Variant Dim sUrl As String, sJson As String, vPrice As Variant ``` sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _ "&key=" & PROXY_SECRET() sJson = HttpGetText(sUrl) If sJson = "" Then FUNDPRICE = "#ERROR" Exit Function End If vPrice = JsonNumber(sJson, "price") If IsNull(vPrice) Then FUNDPRICE = "#N/A" Else FUNDPRICE = vPrice End If ``` End Function Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant Dim sUrl As String, sJson As String, vPrice As Variant ``` sUrl = PROXY_BASE() & "/historical?ticker=" & EncodeUrl(ticker) & _ "&date=" & EncodeUrl(dateStr) & "&key=" & PROXY_SECRET() sJson = HttpGetText(sUrl) If sJson = "" Then FUNDPRICE_HIST = "#ERROR" Exit Function End If vPrice = JsonNumber(sJson, "price") If IsNull(vPrice) Then FUNDPRICE_HIST = "#N/A" Else FUNDPRICE_HIST = vPrice End If ``` End Function ' Returns Yahoo's latest market update date and time as a real Calc ' date/time value. ' ' Example: ' Yahoo JSON: ' "date":"2026-07-27","time":"19:58:00" ' ' FUNDTIME returns: ' 2026-07-27 19:58:00 ' Function FUNDTIME(ticker As String) As Variant Dim sUrl As String Dim sJson As String Dim vDate As Variant Dim vTime As Variant Dim sDateTime As String Dim oDateTime As Date ``` sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _ "&key=" & PROXY_SECRET() sJson = HttpGetText(sUrl) If sJson = "" Then FUNDTIME = "#ERROR" Exit Function End If ' Get the separate date and time values from stockproxy. vDate = JsonString(sJson, "date") vTime = JsonString(sJson, "time") If IsNull(vDate) Or IsNull(vTime) Then FUNDTIME = "#N/A" Exit Function End If ' Combine into a single date/time string. sDateTime = CStr(vDate) & " " & CStr(vTime) ' Convert to a real Calc date/time value. On Error GoTo DateError oDateTime = CDate(sDateTime) FUNDTIME = oDateTime Exit Function ``` DateError: FUNDTIME = "#N/A" End Function ' ---- Internal helpers ---------------------------------------------------- ' Synchronous HTTP GET, returns response body as text, "" on failure. Function HttpGetText(sUrl As String) As String Dim oSFA As Object, oStream As Object, oTextStream As Object Dim sResult As String ``` On Error GoTo ErrHandler oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess") oStream = oSFA.openFileRead(sUrl) oTextStream = createUnoService("com.sun.star.io.TextInputStream") oTextStream.setInputStream(oStream) oTextStream.setEncoding("UTF-8") sResult = "" Do While Not oTextStream.isEOF() sResult = sResult & oTextStream.readLine() & Chr(10) Loop oTextStream.closeInput() HttpGetText = sResult Exit Function ``` ErrHandler: HttpGetText = "" End Function ' Pulls a numeric value out of a flat JSON string for a given key. ' e.g. JsonNumber("{""price"":18.37}", "price") -> 18.37 ' Returns Null if the key isn't found or has no numeric value. Function JsonNumber(sJson As String, sKey As String) As Variant Dim iPos As Integer, iStart As Integer, iEnd As Integer Dim sNum As String, cChar As String ``` iPos = InStr(sJson, Chr(34) & sKey & Chr(34)) If iPos = 0 Then JsonNumber = Null Exit Function End If iPos = InStr(iPos, sJson, ":") If iPos = 0 Then JsonNumber = Null Exit Function End If iStart = iPos + 1 Do While iStart <= Len(sJson) And Mid(sJson, iStart, 1) = " " iStart = iStart + 1 Loop iEnd = iStart Do While iEnd <= Len(sJson) cChar = Mid(sJson, iEnd, 1) If (cChar >= "0" And cChar <= "9") Or _ cChar = "." Or cChar = "-" Then iEnd = iEnd + 1 Else Exit Do End If Loop sNum = Mid(sJson, iStart, iEnd - iStart) If Len(sNum) = 0 Then JsonNumber = Null Else JsonNumber = CDbl(sNum) End If ``` End Function ' Pulls a quoted STRING value out of a flat JSON string for a given key. ' e.g. JsonString("{""resolved_date"":""2026-07-23""}", "resolved_date") ' -> "2026-07-23" ' ' Returns Null if the key isn't found or has no quoted value. Function JsonString(sJson As String, sKey As String) As Variant Dim iPos As Integer Dim iColon As Integer Dim iQuoteStart As Integer Dim iQuoteEnd As Integer ``` iPos = InStr(sJson, Chr(34) & sKey & Chr(34)) If iPos = 0 Then JsonString = Null Exit Function End If iColon = InStr(iPos, sJson, ":") If iColon = 0 Then JsonString = Null Exit Function End If iQuoteStart = InStr(iColon, sJson, Chr(34)) If iQuoteStart = 0 Then JsonString = Null Exit Function End If iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34)) If iQuoteEnd = 0 Then JsonString = Null Exit Function End If JsonString = Mid(sJson, iQuoteStart + 1, _ iQuoteEnd - iQuoteStart - 1) ``` End Function ' Minimal percent-encoder - sufficient for tickers and yyyy-mm-dd strings. Function EncodeUrl(s As String) As String Dim i As Integer, c As String, sOut As String ``` sOut = "" For i = 1 To Len(s) c = Mid(s, i, 1) If (c >= "A" And c <= "Z") Or _ (c >= "a" And c <= "z") Or _ (c >= "0" And c <= "9") Or _ c = "-" Or c = "_" Or c = "." Or c = "~" Then sOut = sOut & c Else sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2) End If Next i EncodeUrl = sOut ``` End Function Sub RefreshPriceSnapshot Dim oDoc As Object, oSheet As Object Dim oSrcRange As Object, oDestRange As Object Dim oCell As Object Dim i As Integer ``` oDoc = ThisComponent oSheet = oDoc.Sheets.getByIndex(0) ' adjust index/name if needed ' Copy P3:Q53 -> R3:S53 as values only For i = 2 To 4 ' rows 3 to 53 (0-indexed: row 3 = index 2) oSheet.getCellByPosition(17, i).setValue( _ oSheet.getCellByPosition(15, i).getValue()) _ ' P->R (col P=15, R=17) oSheet.getCellByPosition(18, i).setValue( _ oSheet.getCellByPosition(16, i).getValue()) _ ' Q->S (col Q=16, S=18) Next i MsgBox "Price snapshot refreshed." ``` End Sub