NAS08/nas08-scripts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Updated LibreOffice Macro to include timestamp

Browse source
This commit is contained in:
Rufus King 2026-07-27 20:32:25 -04:00
parent 9d0d4271bd
commit bf0f376cdb
1 changed files with 252 additions and 146 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

398
Stocks/WebService/libreoffice_macro.txt
View file

@ -2,17 +2,18 @@
' StockFunctions.bas ' StockFunctions.bas
' Collabora / LibreOffice Basic port of the ONLYOFFICE custom functions. ' Collabora / LibreOffice Basic port of the ONLYOFFICE custom functions.
' '
' UPDATED 2026-07-23: STOCKPRICE / STOCKTIME (Finnhub) removed. ' UPDATED 2026-07-27: FUNDTIME now returns Yahoo's last market update
' Finnhub was dropped because it has no historical price coverage, which is ' date and time as a combined Calc date/time value.
' 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.
' '
' NOTE: resolved_date is a DATE (YYYY-MM-DD), not a time-of-day timestamp. ' FUNDPRICE returns the current price from stockproxy.
' Finnhub's old STOCKTIME gave true time-of-day resolution; this does not. ' FUNDPRICE_HIST returns a historical price from stockproxy.
' If intraday precision is ever needed, stockproxy's /current endpoint ' FUNDTIME returns Yahoo's regularMarketTime as a date/time value.
' would need a real timestamp field added on the backend side. '
' 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: ' HOW TO INSTALL IN COLLABORA:
' 1. Open the sheet in Collabora (collabora.kingdezigns.com). ' 1. Open the sheet in Collabora (collabora.kingdezigns.com).
@ -30,7 +31,7 @@
' =FUNDPRICE(D4) ' =FUNDPRICE(D4)
' =FUNDPRICE_HIST(D4, TEXT($B$3,"yyyy-mm-dd")) ' =FUNDPRICE_HIST(D4, TEXT($B$3,"yyyy-mm-dd"))
' =FUNDPRICE(A5) <- replaces old =STOCKPRICE(A5) ' =FUNDPRICE(A5) <- replaces old =STOCKPRICE(A5)
' =FUNDTIME(A5) <- replaces old =STOCKTIME(A5) ' =FUNDTIME(A5) <- returns Yahoo date/time of latest market update
' ========================================================================= ' =========================================================================
Option Explicit Option Explicit
@ -38,198 +39,303 @@ Option Explicit
' ---- Config ------------------------------------------------------------- ' ---- Config -------------------------------------------------------------
Function PROXY_BASE() As String Function PROXY_BASE() As String
PROXY_BASE = "https://stocks.kingdezigns.com" PROXY_BASE = "https://stocks.kingdezigns.com"
End Function End Function
Function PROXY_SECRET() As String Function PROXY_SECRET() As String
PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc" ' <-- from Vaultwarden PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc" ' <-- from Vaultwarden
End Function End Function
' ---- Public spreadsheet functions --------------------------------------- ' ---- Public spreadsheet functions ---------------------------------------
Function FUNDPRICE(ticker As String) As Variant Function FUNDPRICE(ticker As String) As Variant
Dim sUrl As String, sJson As String, vPrice 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 sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
FUNDPRICE = "#ERROR" "&key=" & PROXY_SECRET()
Exit Function
End If sJson = HttpGetText(sUrl)
vPrice = JsonNumber(sJson, "price")
If IsNull(vPrice) Then If sJson = "" Then
FUNDPRICE = "#N/A" FUNDPRICE = "#ERROR"
Else Exit Function
FUNDPRICE = vPrice End If
End If
vPrice = JsonNumber(sJson, "price")
If IsNull(vPrice) Then
FUNDPRICE = "#N/A"
Else
FUNDPRICE = vPrice
End If
```
End Function End Function
Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant
Dim sUrl As String, sJson As String, vPrice 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) sUrl = PROXY_BASE() & "/historical?ticker=" & EncodeUrl(ticker) & _
If sJson = "" Then "&date=" & EncodeUrl(dateStr) & "&key=" & PROXY_SECRET()
FUNDPRICE_HIST = "#ERROR"
Exit Function sJson = HttpGetText(sUrl)
End If
vPrice = JsonNumber(sJson, "price") If sJson = "" Then
If IsNull(vPrice) Then FUNDPRICE_HIST = "#ERROR"
FUNDPRICE_HIST = "#N/A" Exit Function
Else End If
FUNDPRICE_HIST = vPrice
End If vPrice = JsonNumber(sJson, "price")
If IsNull(vPrice) Then
FUNDPRICE_HIST = "#N/A"
Else
FUNDPRICE_HIST = vPrice
End If
```
End Function End Function
' Replaces old STOCKTIME(ticker). Returns stockproxy's resolved_date ' Returns Yahoo's latest market update date and time as a real Calc
' (YYYY-MM-DD) — a date, not a time-of-day timestamp. See note at top. ' 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 Function FUNDTIME(ticker As String) As Variant
Dim sUrl As String, sJson As String, vDate As Variant Dim sUrl As String
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & "&key=" & PROXY_SECRET() Dim sJson As String
sJson = HttpGetText(sUrl) Dim vDate As Variant
If sJson = "" Then Dim vTime As Variant
FUNDTIME = "#ERROR" Dim sDateTime As String
Exit Function Dim oDateTime As Date
End If
vDate = JsonString(sJson, "resolved_date") ```
If IsNull(vDate) Then sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
FUNDTIME = "#N/A" "&key=" & PROXY_SECRET()
Else
FUNDTIME = vDate sJson = HttpGetText(sUrl)
End If
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 End Function
' ---- Internal helpers ---------------------------------------------------- ' ---- Internal helpers ----------------------------------------------------
' Synchronous HTTP GET, returns response body as text, "" on failure. ' Synchronous HTTP GET, returns response body as text, "" on failure.
Function HttpGetText(sUrl As String) As String Function HttpGetText(sUrl As String) As String
Dim oSFA As Object, oStream As Object, oTextStream As Object Dim oSFA As Object, oStream As Object, oTextStream As Object
Dim sResult As String Dim sResult As String
On Error GoTo ErrHandler ```
oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess") On Error GoTo ErrHandler
oStream = oSFA.openFileRead(sUrl)
oTextStream = createUnoService("com.sun.star.io.TextInputStream")
oTextStream.setInputStream(oStream)
oTextStream.setEncoding("UTF-8")
sResult = "" oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")
Do While Not oTextStream.isEOF() oStream = oSFA.openFileRead(sUrl)
sResult = sResult & oTextStream.readLine() & Chr(10)
Loop oTextStream = createUnoService("com.sun.star.io.TextInputStream")
oTextStream.closeInput() oTextStream.setInputStream(oStream)
HttpGetText = sResult oTextStream.setEncoding("UTF-8")
Exit Function
sResult = ""
Do While Not oTextStream.isEOF()
sResult = sResult & oTextStream.readLine() & Chr(10)
Loop
oTextStream.closeInput()
HttpGetText = sResult
Exit Function
```
ErrHandler: ErrHandler:
HttpGetText = "" HttpGetText = ""
End Function End Function
' Pulls a numeric value out of a flat JSON string for a given key. ' Pulls a numeric value out of a flat JSON string for a given key.
' e.g. JsonNumber("{""price"":18.37}", "price") -> 18.37 ' e.g. JsonNumber("{""price"":18.37}", "price") -> 18.37
' Returns Null if the key isn't found or has no numeric value. ' Returns Null if the key isn't found or has no numeric value.
Function JsonNumber(sJson As String, sKey As String) As Variant Function JsonNumber(sJson As String, sKey As String) As Variant
Dim iPos As Integer, iStart As Integer, iEnd As Integer Dim iPos As Integer, iStart As Integer, iEnd As Integer
Dim sNum As String, cChar As String Dim sNum As String, cChar As String
iPos = InStr(sJson, Chr(34) & sKey & Chr(34)) ```
If iPos = 0 Then iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
JsonNumber = Null
Exit Function
End If
iPos = InStr(iPos, sJson, ":") If iPos = 0 Then
If iPos = 0 Then JsonNumber = Null
JsonNumber = Null Exit Function
Exit Function End If
End If
iStart = iPos + 1 iPos = InStr(iPos, sJson, ":")
Do While iStart <= Len(sJson) And Mid(sJson, iStart, 1) = " "
iStart = iStart + 1
Loop
iEnd = iStart If iPos = 0 Then
Do While iEnd <= Len(sJson) JsonNumber = Null
cChar = Mid(sJson, iEnd, 1) Exit Function
If (cChar >= "0" And cChar <= "9") Or cChar = "." Or cChar = "-" Then End If
iEnd = iEnd + 1
Else
Exit Do
End If
Loop
sNum = Mid(sJson, iStart, iEnd - iStart) iStart = iPos + 1
If Len(sNum) = 0 Then
JsonNumber = Null 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 Else
JsonNumber = CDbl(sNum) Exit Do
End If End If
Loop
sNum = Mid(sJson, iStart, iEnd - iStart)
If Len(sNum) = 0 Then
JsonNumber = Null
Else
JsonNumber = CDbl(sNum)
End If
```
End Function End Function
' Pulls a quoted STRING value out of a flat JSON string for a given key. ' 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") ' e.g. JsonString("{""resolved_date"":""2026-07-23""}", "resolved_date")
' -> "2026-07-23" ' -> "2026-07-23"
'
' Returns Null if the key isn't found or has no quoted value. ' Returns Null if the key isn't found or has no quoted value.
Function JsonString(sJson As String, sKey As String) As Variant 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 iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
JsonString = Null
Exit Function
End If
iColon = InStr(iPos, sJson, ":") If iPos = 0 Then
If iColon = 0 Then JsonString = Null
JsonString = Null Exit Function
Exit Function End If
End If
iQuoteStart = InStr(iColon, sJson, Chr(34)) iColon = InStr(iPos, sJson, ":")
If iQuoteStart = 0 Then
JsonString = Null
Exit Function
End If
iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34)) If iColon = 0 Then
If iQuoteEnd = 0 Then JsonString = Null
JsonString = Null Exit Function
Exit Function End If
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 End Function
' Minimal percent-encoder - sufficient for tickers and yyyy-mm-dd strings. ' Minimal percent-encoder - sufficient for tickers and yyyy-mm-dd strings.
Function EncodeUrl(s As String) As String Function EncodeUrl(s As String) As String
Dim i As Integer, c As String, sOut As String Dim i As Integer, c As String, sOut As String
sOut = ""
For i = 1 To Len(s) ```
c = Mid(s, i, 1) sOut = ""
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 For i = 1 To Len(s)
sOut = sOut & c c = Mid(s, i, 1)
Else
sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2) If (c >= "A" And c <= "Z") Or _
End If (c >= "a" And c <= "z") Or _
Next i (c >= "0" And c <= "9") Or _
EncodeUrl = sOut 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 End Function
Sub RefreshPriceSnapshot Sub RefreshPriceSnapshot
Dim oDoc As Object, oSheet As Object Dim oDoc As Object, oSheet As Object
Dim oSrcRange As Object, oDestRange As Object Dim oSrcRange As Object, oDestRange As Object
Dim oCell As Object Dim oCell As Object
Dim i As Integer Dim i As Integer
oDoc = ThisComponent ```
oSheet = oDoc.Sheets.getByIndex(0) ' adjust index/name if needed oDoc = ThisComponent
oSheet = oDoc.Sheets.getByIndex(0) ' adjust index/name if needed
' Copy P3:Q53 -> R3:S53 as values only ' Copy P3:Q53 -> R3:S53 as values only
For i = 2 To 4 ' rows 3 to 53 (0-indexed: row 3 = index 2) 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( _
Next i 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."
```
MsgBox "Price snapshot refreshed."
End Sub End Sub