Fix ChatGPT error
This commit is contained in:
parent
bf0f376cdb
commit
f68993cc14
1 changed files with 188 additions and 239 deletions
|
|
@ -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.
|
||||
' 2026-07-27 19:58:00
|
||||
'
|
||||
' 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
|
||||
|
|
@ -39,303 +14,277 @@ Option Explicit
|
|||
' ---- Config -------------------------------------------------------------
|
||||
|
||||
Function PROXY_BASE() As String
|
||||
PROXY_BASE = "https://stocks.kingdezigns.com"
|
||||
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()
|
||||
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
|
||||
"&key=" & PROXY_SECRET()
|
||||
|
||||
sJson = HttpGetText(sUrl)
|
||||
sJson = HttpGetText(sUrl)
|
||||
|
||||
If sJson = "" Then
|
||||
FUNDPRICE = "#ERROR"
|
||||
Exit Function
|
||||
End If
|
||||
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
|
||||
```
|
||||
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
|
||||
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()
|
||||
sUrl = PROXY_BASE() & "/historical?ticker=" & EncodeUrl(ticker) & _
|
||||
"&date=" & EncodeUrl(dateStr) & _
|
||||
"&key=" & PROXY_SECRET()
|
||||
|
||||
sJson = HttpGetText(sUrl)
|
||||
sJson = HttpGetText(sUrl)
|
||||
|
||||
If sJson = "" Then
|
||||
FUNDPRICE_HIST = "#ERROR"
|
||||
Exit Function
|
||||
End If
|
||||
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
|
||||
```
|
||||
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.
|
||||
|
||||
' ---- 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
|
||||
' 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
|
||||
' 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 sDate As String
|
||||
Dim sTime As String
|
||||
|
||||
```
|
||||
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
|
||||
"&key=" & PROXY_SECRET()
|
||||
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
|
||||
"&key=" & PROXY_SECRET()
|
||||
|
||||
sJson = HttpGetText(sUrl)
|
||||
sJson = HttpGetText(sUrl)
|
||||
|
||||
If sJson = "" Then
|
||||
FUNDTIME = "#ERROR"
|
||||
Exit Function
|
||||
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")
|
||||
sDate = JsonString(sJson, "date")
|
||||
sTime = JsonString(sJson, "time")
|
||||
|
||||
If IsNull(vDate) Or IsNull(vTime) Then
|
||||
FUNDTIME = "#N/A"
|
||||
Exit Function
|
||||
End If
|
||||
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 sResult As String
|
||||
Dim oSFA As Object
|
||||
Dim oStream As Object
|
||||
Dim oTextStream As Object
|
||||
Dim sResult As String
|
||||
|
||||
```
|
||||
On Error GoTo ErrHandler
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
oStream = oSFA.openFileRead(sUrl)
|
||||
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")
|
||||
oTextStream = createUnoService("com.sun.star.io.TextInputStream")
|
||||
oTextStream.setInputStream(oStream)
|
||||
oTextStream.setEncoding("UTF-8")
|
||||
|
||||
sResult = ""
|
||||
sResult = ""
|
||||
|
||||
Do While Not oTextStream.isEOF()
|
||||
sResult = sResult & oTextStream.readLine() & Chr(10)
|
||||
Loop
|
||||
Do While Not oTextStream.isEOF()
|
||||
sResult = sResult & oTextStream.readLine() & Chr(10)
|
||||
Loop
|
||||
|
||||
oTextStream.closeInput()
|
||||
oTextStream.closeInput()
|
||||
|
||||
HttpGetText = sResult
|
||||
Exit Function
|
||||
```
|
||||
HttpGetText = sResult
|
||||
Exit Function
|
||||
|
||||
ErrHandler:
|
||||
HttpGetText = ""
|
||||
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
|
||||
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))
|
||||
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
|
||||
If iPos = 0 Then
|
||||
JsonNumber = Null
|
||||
Exit Function
|
||||
End If
|
||||
Loop
|
||||
|
||||
sNum = Mid(sJson, iStart, iEnd - iStart)
|
||||
iPos = InStr(iPos, sJson, ":")
|
||||
|
||||
If Len(sNum) = 0 Then
|
||||
JsonNumber = Null
|
||||
Else
|
||||
JsonNumber = CDbl(sNum)
|
||||
End If
|
||||
```
|
||||
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))
|
||||
' 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
|
||||
|
||||
If iPos = 0 Then
|
||||
JsonString = Null
|
||||
Exit Function
|
||||
End If
|
||||
iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
|
||||
|
||||
iColon = InStr(iPos, sJson, ":")
|
||||
If iPos = 0 Then
|
||||
JsonString = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If iColon = 0 Then
|
||||
JsonString = Null
|
||||
Exit Function
|
||||
End If
|
||||
iColon = InStr(iPos, sJson, ":")
|
||||
|
||||
iQuoteStart = InStr(iColon, sJson, Chr(34))
|
||||
If iColon = 0 Then
|
||||
JsonString = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If iQuoteStart = 0 Then
|
||||
JsonString = Null
|
||||
Exit Function
|
||||
End If
|
||||
iQuoteStart = InStr(iColon, sJson, Chr(34))
|
||||
|
||||
iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34))
|
||||
If iQuoteStart = 0 Then
|
||||
JsonString = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If iQuoteEnd = 0 Then
|
||||
JsonString = Null
|
||||
Exit Function
|
||||
End If
|
||||
iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34))
|
||||
|
||||
JsonString = Mid(sJson, iQuoteStart + 1, _
|
||||
iQuoteEnd - iQuoteStart - 1)
|
||||
```
|
||||
If iQuoteEnd = 0 Then
|
||||
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.
|
||||
|
||||
' Minimal percent-encoder.
|
||||
Function EncodeUrl(s As String) As String
|
||||
Dim i As Integer, c As String, sOut As String
|
||||
Dim i As Integer
|
||||
Dim c As String
|
||||
Dim sOut As String
|
||||
|
||||
```
|
||||
sOut = ""
|
||||
sOut = ""
|
||||
|
||||
For i = 1 To Len(s)
|
||||
c = Mid(s, i, 1)
|
||||
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
|
||||
sOut = sOut & c
|
||||
|
||||
Else
|
||||
Else
|
||||
|
||||
sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2)
|
||||
sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2)
|
||||
|
||||
End If
|
||||
Next i
|
||||
|
||||
EncodeUrl = sOut
|
||||
```
|
||||
End If
|
||||
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 i As Integer
|
||||
Dim oDoc As Object
|
||||
Dim oSheet As Object
|
||||
Dim i As Integer
|
||||
|
||||
```
|
||||
oDoc = ThisComponent
|
||||
oSheet = oDoc.Sheets.getByIndex(0) ' adjust index/name if needed
|
||||
oDoc = ThisComponent
|
||||
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)
|
||||
' Copy P3:Q53 -> R3:S53 as values only
|
||||
For i = 2 To 4
|
||||
|
||||
oSheet.getCellByPosition(17, i).setValue( _
|
||||
oSheet.getCellByPosition(15, i).getValue()) _
|
||||
' P->R (col P=15, R=17)
|
||||
oSheet.getCellByPosition(17, i).setValue( _
|
||||
oSheet.getCellByPosition(15, i).getValue())
|
||||
|
||||
oSheet.getCellByPosition(18, i).setValue( _
|
||||
oSheet.getCellByPosition(16, i).getValue()) _
|
||||
' Q->S (col Q=16, S=18)
|
||||
oSheet.getCellByPosition(18, i).setValue( _
|
||||
oSheet.getCellByPosition(16, i).getValue())
|
||||
|
||||
Next i
|
||||
|
||||
MsgBox "Price snapshot refreshed."
|
||||
```
|
||||
Next i
|
||||
|
||||
MsgBox "Price snapshot refreshed."
|
||||
End Sub
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue