שערים יציגים מבנק ישראל - VBA אקסס

ארי

ערב טוב.
לאחר עדכון הAPI של בנק ישראל לקבלת שערי חליפין, יצרתי קוד VBA לקבלת הנתונים העדכניים.
מצורף לתועלת הציבור, וכמובן אשמח לכל הערה!

Option Compare Database
Option Explicit

Public Enum StrCurr
    USD = 1
    GBP = 2
    SEK = 3
    CHF = 4
    CAD = 5
    NZD = 6
    DKK = 7
    SGD = 8
    HKD = 9
    ZAR = 10
    AUD = 11
    EUR = 12
    JOD = 13
    NOK = 14
    JPY = 15
    RUB = 16
    PLN = 17
    MXN = 18
    CZK = 19
    TRY = 20
    LBP = 21
    EGP = 22
    HUF = 23
    INR = 24
    CNY = 25
End Enum

Public Type Rate
    Sum As Double
    CuDate As Date
End Type

Public Function test()
Dim Rates As Rate

Rates = GetExchangeRates

With Rates
    Debug.Print .CuDate
    Debug.Print .Sum
End With

End Function

Public Function GetExchangeRates(Optional Dtdate As Date, Optional StrCurr As StrCurr = USD) As Rate
Dim str As String
Dim Json As Object
Dim item As Variant
Dim element As Variant
Dim CurrName As String
Dim Sum As Double
    Dim i As String

If Dtdate = "00:00:00" Then Dtdate = Date

Select Case StrCurr
    Case 1: CurrName = "USD"
    Case 2: CurrName = "GBP"
    Case 3: CurrName = "SEK"
    Case 4: CurrName = "CHF"
    Case 5: CurrName = "CAD"
    Case 6: CurrName = "NZD"
    Case 7: CurrName = "DKK"
    Case 8: CurrName = "SGD"
    Case 9: CurrName = "HKD"
    Case 10: CurrName = "ZAR"
    Case 11: CurrName = "AUD"
    Case 12: CurrName = "EUR"
    Case 13: CurrName = "JOD"
    Case 14: CurrName = "NOK"
    Case 15: CurrName = "JPY"
    Case 16: CurrName = "RUB"
    Case 17: CurrName = "PLN"
    Case 18: CurrName = "MXN"
    Case 19: CurrName = "CZK"
    Case 20: CurrName = "TRY"
    Case 21: CurrName = "LBP"
    Case 22: CurrName = "EGP"
    Case 23: CurrName = "HUF"
    Case 24: CurrName = "INR"
    Case 25: CurrName = "CNY"
    Case Else: CurrName = ""
End Select

Select Case CurrName
    Case ""
        MsgBox "קוד מטבע לא חוקי!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
    Case Else
        
        str = "https://edge.boi.gov.il/FusionEdgeServer/sdmx/v2/data/dataflow/BOI.STATISTICS/EXR/1.0/RER_" & CurrName & "_ILS?startperiod=" & Format(Dtdate - 7, "YYYY-MM-DD") & "&endperiod=" & Format(Dtdate, "YYYY-MM-DD") & "&format=sdmx-json"
                
        With CreateObject("MSXML2.ServerXMLHTTP.6.0")
            .Open "GET", str, False
            .send
            str = .responseText
        End With

        Set Json = JsonConverter.ParseJson(str)
        
        
        For Each item In Json("data")("dataSets")(1)("series")("0:0:0:0:0:0")("observations")
            GetExchangeRates.Sum = Json("data")("dataSets")(1)("series")("0:0:0:0:0:0")("observations")(item)(1)
        Next item
        
        For Each item In Json("data")("structure")("dimensions")("observation")(1)("values")
            GetExchangeRates.CuDate = item("name")
        Next item
    End Select
    
End Function

שמעון חבצלת

@ארי אני לא מספיק מבין בקוד הזה. רציתי לדעת באיזה פונקציה אני משתמש כדי להמיר את הסכום הקיים לשער של דולר, ואיל לכתוב אותה.
יש לי תוכנה עם סכומים אני רוצה שבעת לחיצה כפולה על הסכום הוא יכפיל את הסכום בשער הדולר.
איך לכתוב את הקוד? באיזה פונקציה להשתמש ואיך אפשר להשתמש איתה בשביל מה שאני צריך?
(את הקוד עצמו זרקתי במודל 1)
תודה רבה!!!

ארי

@שמעון-חבצלת באירוע בעת לחיצה כפולה אתה שם

me.shekel = me.dollar * GetExchangeRates.sum

מלא

@ארי כתב בשערים יציגים מבנק ישראל - VBA אקסס:

    MsgBox "÷åã îèáò ìà çå÷é!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight

ארי

@מלא תוקן.
תודה.

שמעון חבצלת

@ארי תודה רבה על כל העזרה,
אבל הקוד נתקע כאן:

ארי

@שמעון-חבצלת סליחה, שכחתי לציין שצריך קוד שממיר Json לאקסס.
תוסיף את הקוד שיש בקובץ המצורף לVBA שלך (בתוך חלון הVBA בצד ימין איפה שכל המודולים, לחיצה על המקש הימני בעכבר ועל ייבוא מקובץ).

JsonConverter.bas

שמעון חבצלת

@ארי תודה על הכל
א. עכשיו הוא מקפיץ לי את החלון הזה

ב. האם יש אפשרות שזה יעבוד גם אופליין ויזכור את הפעם האחרונה?

ארי

@שמעון-חבצלת א. אתה צריך להוסיף לreferences את Microsoft scripting runtime.
ב. אתה יכול ליצור טבלה ובה לשמור את הערך האחרון שמתקבל בכל קריאה.

שמעון חבצלת

@ארי א. לא הבנתי מה אתה אומר... סליחה שאני ככה משגע אותך אבל אני לא ממש מבין בקודים.
ב. לשמור בטבלה אני יודע השאלה איך אני מגדיר שכאשר אין אינטרנט הוא לוקח משם. (לא אכפת לי שיקח תמיד מהטבלא ופעם ביום זה יעדכן)...
תודה ארי

איש ימיני

@ארי הקישור של בנק ישראל הפסיק לעבוד.
הקוד לא עובד.
יש למישהו מושג מה הקישור המעודכן?

איש ימיני

שיניתי את הקוד עבור שער יציג של הדולר:
(עבורי זה מספיק)

Option Compare Database
Option Explicit
 
Public Function GetExchangeRatesUSD()
Dim str As String
Dim Json As Object

        str = "https://boi.org.il/PublicApi/GetExchangeRate?key=USD"
             
        With CreateObject("MSXML2.ServerXMLHTTP.6.0")
            .Open "GET", str, False
            .send
            str = .responseText
        End With
 
        Set Json = JsonConverter.ParseJson(str)
        GetExchangeRatesUSD = Json("currentExchangeRate")
End Function

ארי

@איש-ימיני איזה קישור לא עבד לך?
לי הקוד עבד מצוין. וגם הקישור הזה עבד.

איש ימיני

הקישור הזה לא עבד.
זה החזיר שגיאה.
אני רואה שעכשיו כן עובד.
מוזר.

ארי

@איש-ימיני מוזר.
אולי יש עבודות תחזוקה או משהו כזה.

תחומים - פורום חרדי מקצועי

שערים יציגים מבנק ישראל - VBA אקסס