Fix ChatGPT error

This commit is contained in:
Rufus King 2026-07-27 20:35:27 -04:00
parent bf0f376cdb
commit f68993cc14

View file

@ -1,37 +1,12 @@
' =========================================================================
' StockFunctions.bas
' Collabora / LibreOffice Basic port of the ONLYOFFICE custom functions.
' Collabora / LibreOffice Basic
'
' UPDATED 2026-07-27: FUNDTIME now returns Yahoo's last market update
' date and time as a combined Calc date/time value.
' FUNDTIME now returns Yahoo's latest market update date/time:
'
' 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 "<Your Document Name>" (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
' The date and time are obtained from the stockproxy /current endpoint.
' =========================================================================
Option Explicit
@ -43,15 +18,17 @@ PROXY_BASE = "https://stocks.kingdezigns.com"
End Function
Function PROXY_SECRET() As String
PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc" ' <-- from Vaultwarden
PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc"
End Function
' ---- Public spreadsheet functions ---------------------------------------
Function FUNDPRICE(ticker As String) As Variant
Dim sUrl As String, sJson As String, vPrice As Variant
Dim sUrl As String
Dim sJson As String
Dim vPrice As Variant
```
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
"&key=" & PROXY_SECRET()
@ -69,16 +46,17 @@ If IsNull(vPrice) Then
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
```
Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant
Dim sUrl As String
Dim sJson As String
Dim vPrice As Variant
sUrl = PROXY_BASE() & "/historical?ticker=" & EncodeUrl(ticker) & _
"&date=" & EncodeUrl(dateStr) & "&key=" & PROXY_SECRET()
"&date=" & EncodeUrl(dateStr) & _
"&key=" & PROXY_SECRET()
sJson = HttpGetText(sUrl)
@ -94,29 +72,23 @@ If IsNull(vPrice) Then
Else
FUNDPRICE_HIST = vPrice
End If
```
End Function
' Returns Yahoo's latest market update date and time as a real Calc
' date/time value.
' ---- Yahoo market update date/time --------------------------------------
'
' Example:
' Yahoo JSON:
' "date":"2026-07-27","time":"19:58:00"
' Returns:
'
' FUNDTIME returns:
' 2026-07-27 19:58:00
'
Function FUNDTIME(ticker As String) As Variant
' This combines the "date" and "time" fields returned by stockproxy.
'
Function FUNDTIME(ticker As String) As String
Dim sUrl As String
Dim sJson As String
Dim vDate As Variant
Dim vTime As Variant
Dim sDateTime As String
Dim oDateTime As Date
Dim sDate As String
Dim sTime As String
```
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
"&key=" & PROXY_SECRET()
@ -127,38 +99,27 @@ If sJson = "" Then
Exit Function
End If
' Get the separate date and time values from stockproxy.
vDate = JsonString(sJson, "date")
vTime = JsonString(sJson, "time")
sDate = JsonString(sJson, "date")
sTime = JsonString(sJson, "time")
If IsNull(vDate) Or IsNull(vTime) Then
If sDate = "" Or sTime = "" 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"
FUNDTIME = sDate & " " & sTime
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 oSFA As Object
Dim oStream As Object
Dim oTextStream As Object
Dim sResult As String
```
On Error GoTo ErrHandler
oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")
@ -178,20 +139,20 @@ 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
```
' Pulls a numeric value out of a flat JSON string for a given key.
Function JsonNumber(sJson As String, sKey As String) As Variant
Dim iPos As Integer
Dim iStart As Integer
Dim iEnd As Integer
Dim sNum As String
Dim cChar As String
iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
If iPos = 0 Then
@ -232,61 +193,55 @@ If Len(sNum) = 0 Then
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
' Pulls a quoted string value out of a flat JSON string.
Function JsonString(sJson As String, sKey As String) As String
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
JsonString = ""
Exit Function
End If
iColon = InStr(iPos, sJson, ":")
If iColon = 0 Then
JsonString = Null
JsonString = ""
Exit Function
End If
iQuoteStart = InStr(iColon, sJson, Chr(34))
If iQuoteStart = 0 Then
JsonString = Null
JsonString = ""
Exit Function
End If
iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34))
If iQuoteEnd = 0 Then
JsonString = Null
JsonString = ""
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
```
' Minimal percent-encoder.
Function EncodeUrl(s As String) As String
Dim i As Integer
Dim c As String
Dim sOut As String
sOut = ""
For i = 1 To Len(s)
@ -307,35 +262,29 @@ For i = 1 To Len(s)
Next i
EncodeUrl = sOut
```
End Function
' ---- Snapshot ------------------------------------------------------------
Sub RefreshPriceSnapshot
Dim oDoc As Object, oSheet As Object
Dim oSrcRange As Object, oDestRange As Object
Dim oCell As Object
Dim oDoc As Object
Dim oSheet As Object
Dim i As Integer
```
oDoc = ThisComponent
oSheet = oDoc.Sheets.getByIndex(0) ' adjust index/name if needed
oSheet = oDoc.Sheets.getByIndex(0)
' 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
oSheet.getCellByPosition(17, i).setValue( _
oSheet.getCellByPosition(15, i).getValue()) _
' P->R (col P=15, R=17)
oSheet.getCellByPosition(15, i).getValue())
oSheet.getCellByPosition(18, i).setValue( _
oSheet.getCellByPosition(16, i).getValue()) _
' Q->S (col Q=16, S=18)
oSheet.getCellByPosition(16, i).getValue())
Next i
MsgBox "Price snapshot refreshed."
```
End Sub