Updated LibreOffice Macro to include timestamp

This commit is contained in:
Rufus King 2026-07-27 20:32:25 -04:00
parent 9d0d4271bd
commit bf0f376cdb

View file

@ -2,17 +2,18 @@
' StockFunctions.bas
' Collabora / LibreOffice Basic port of the ONLYOFFICE custom functions.
'
' UPDATED 2026-07-23: STOCKPRICE / STOCKTIME (Finnhub) removed.
' Finnhub was dropped because it has no historical price coverage, which is
' why stockproxy (NAS08) was built in the first place. FUNDPRICE already
' works for any ticker stockproxy knows about, fund or stock, so it now
' doubles as the equity price function. FUNDTIME replaces STOCKTIME and
' returns stockproxy's "resolved_date" field.
' UPDATED 2026-07-27: FUNDTIME now returns Yahoo's last market update
' date and time as a combined Calc date/time value.
'
' NOTE: resolved_date is a DATE (YYYY-MM-DD), not a time-of-day timestamp.
' Finnhub's old STOCKTIME gave true time-of-day resolution; this does not.
' If intraday precision is ever needed, stockproxy's /current endpoint
' would need a real timestamp field added on the backend side.
' 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).
@ -30,7 +31,7 @@
' =FUNDPRICE(D4)
' =FUNDPRICE_HIST(D4, TEXT($B$3,"yyyy-mm-dd"))
' =FUNDPRICE(A5) <- replaces old =STOCKPRICE(A5)
' =FUNDTIME(A5) <- replaces old =STOCKTIME(A5)
' =FUNDTIME(A5) <- returns Yahoo date/time of latest market update
' =========================================================================
Option Explicit
@ -49,53 +50,105 @@ End Function
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()
```
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
' Replaces old STOCKTIME(ticker). Returns stockproxy's resolved_date
' (YYYY-MM-DD) — a date, not a time-of-day timestamp. See note at top.
' 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, sJson As String, vDate As Variant
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & "&key=" & PROXY_SECRET()
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
vDate = JsonString(sJson, "resolved_date")
If IsNull(vDate) Then
' 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"
Else
FUNDTIME = vDate
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 ----------------------------------------------------
@ -105,20 +158,27 @@ 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 = ""
@ -131,27 +191,34 @@ 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
If (cChar >= "0" And cChar <= "9") Or _
cChar = "." Or cChar = "-" Then
iEnd = iEnd + 1
Else
Exit Do
@ -159,61 +226,89 @@ Function JsonNumber(sJson As String, sKey As String) As Variant
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, iColon As Integer, iQuoteStart As Integer, iQuoteEnd As Integer
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)
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
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
@ -222,14 +317,25 @@ Sub RefreshPriceSnapshot
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)
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