אופיס 365 קוד לקבלת שער יציג מבנק ישראל באקסס

אפר

סתם מתעניין...
מנוי פרימיום

אפר

סתם מתעניין...
מנוי פרימיום
בנק ישראל החליפה את הלינק ואין האפשרות לבקש לפי תאריך והפונקציה הנ"ל הפסיקה לעבוד
יש אפשרות לבקש לפי תאריך - כך נראה במבט מלמעלה
מאוחר יותר אבדוק לעומק בעז"ה
להחליף לפונקציה הבאה
לגבי היורו לא ברור לי אם זה 20 או 27 אני לקחתי מכאן וזה 20 ובמקורי היה 27 שם זה דינר ירדני
תחליפו לפי מה שאתם רוצים
קוד:
Public Function GetNISExchangeRate(Optional dtDate As Date = #1/1/1900#, Optional strCurr As String = "01") As Double

    Dim strURL As String
    Dim strResult As String
    Dim lngStartPosition As Long
    Dim lngEndPosition As Long
    Dim strFirstSearch As String
    Dim strLastSearch As String
    Dim dtPreviousDate As Date
    Dim NameCurr As String
    Dim i As Integer
    
    Select Case strCurr
        Case "01": NameCurr = "USD"
        Case "02": NameCurr = "GBP"
        Case "03": NameCurr = "SEK"
        Case "05": NameCurr = "CHF"
        Case "06": NameCurr = "CAD"
        Case "09": NameCurr = "NZD"
        Case "12": NameCurr = "DKK"
        Case "13": NameCurr = "SGD"
        Case "14": NameCurr = "HKD"
        Case "17": NameCurr = "ZAR"
        Case "18": NameCurr = "AUD"
        Case "20": NameCurr = "EUR"
        Case "27": NameCurr = "JOD"
        Case "28": NameCurr = "NOK"
        Case "30": NameCurr = "JPY"
        Case "53": NameCurr = "RUB"
        Case "55": NameCurr = "PLN"
        Case "59": NameCurr = "MXN"
        Case "61": NameCurr = "CZK"
        Case "64": NameCurr = "TRY"
        Case "65": NameCurr = "LBP"
        Case "68": NameCurr = "EGP"
        Case "72": NameCurr = "HUF"
        Case "73": NameCurr = "INR"
        Case "77": NameCurr = "CNY"
        Case "00", "99": NameCurr = "ILS"
        Case Else: NameCurr = ""
    End Select
    
    Select Case NameCurr
        Case ""
            MsgBox "קוד מטבע לא חוקי!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
        Case "ILS"
            GetNISExchangeRate = 1
        Case Else
            strFirstSearch = """currentExchangeRate"":"
            strLastSearch = ","
        
            If dtDate = #1/1/1900# Then
                dtDate = Date
            End If
            If IsConnected Then
                If dtDate > #1/1/1900# Then
                    strFirstSearch = "OBS_VALUE="""
                    strLastSearch = """>"
                    strURL = "https://edge.boi.gov.il/FusionEdgeServer/sdmx/v2/data/dataflow/BOI.STATISTICS/EXR/1.0/RER_" & NameCurr _
                                & "_ILS?startperiod=" & Format(dtDate - 7, "YYYY-MM-DD") & "&endperiod=" & Format(dtDate, "YYYY-MM-DD")
                    strResult = GetHTML(strURL)
                    If Len(strResult) > 0 Then
                        strResult = Right(strResult, 130)
                        lngStartPosition = InStr(1, strResult, strFirstSearch, vbTextCompare)
                        lngEndPosition = CLng(InStr(lngStartPosition + 1, strResult, strLastSearch, vbTextCompare))
                        If lngStartPosition > 0 Then
                            GetNISExchangeRate = Mid(strResult, lngStartPosition + Len(strFirstSearch), lngEndPosition - CLng(lngStartPosition + Len(strFirstSearch)))
                        End If
                    End If
                Else
                    strFirstSearch = """currentExchangeRate"":"
                    strLastSearch = ","
                    strURL = "https://www.boi.org.il/PublicApi/GetExchangeRate?key=" & NameCurr
                    strResult = GetHTML(strURL)
                    If Len(strResult) > 0 Then
                        lngStartPosition = InStr(1, strResult, strFirstSearch, vbTextCompare)
                        lngEndPosition = CLng(InStr(lngStartPosition, strResult, strLastSearch, vbTextCompare))
                        If lngStartPosition > -1 Then
                            GetNISExchangeRate = Mid(strResult, lngStartPosition + Len(strFirstSearch), lngEndPosition - CLng(lngStartPosition + Len(strFirstSearch)))
                        End If
                    End If
                End If
            Else
                MsgBox "לא זוהה חיבור לאינטרנט!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
            End If
    End Select
End Function
 

ari rm

משתמש פעיל
נראה לי שזה מיותר כאן
If dtDate = #1/1/1900# Then
dtDate = Date
End If
למה אתה חושב?
אתה רוצה לקבל את השער של התאריך הזה?
הסבר: זה מה שהוא שם ברירת מחדל, כלומר אם אתה לא מכניס שום תאריך זה יהיה התאריך שתקבל, ולכן הוא בודק שאם זה התאריך שנבחר (= ברירת מחדל) - הוא מחליף לתאריך של היום.
מה שכן הייתי עושה, זה להחליף את זה
Public Function GetNISExchangeRate(Optional dtDate As Date = #1/1/1900#,
בזה:
קוד:
Public Function GetNISExchangeRate(Optional dtDate As Date = Date,
 

משה יעקב

משתמש רשום
בתנאי הזה
If dtDate > #1/1/1900# Then
הוא לוקח השער עם לינק יותר קצר ואם אתה מעדכן התאריך זה עובר ברגיל
 

אולי מעניין אותך גם...

הפרק היומי

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


תהילים פרק קכו

א שִׁיר הַמַּעֲלוֹת בְּשׁוּב יי אֶת שִׁיבַת צִיּוֹן הָיִינוּ כְּחֹלְמִים:ב אָז יִמָּלֵא שְׂחוֹק פִּינוּ וּלְשׁוֹנֵנוּ רִנָּה אָז יֹאמְרוּ בַגּוֹיִם הִגְדִּיל יי לַעֲשׂוֹת עִם אֵלֶּה:ג הִגְדִּיל יי לַעֲשׂוֹת עִמָּנוּ הָיִינוּ שְׂמֵחִים:ד שׁוּבָה יי אֶת (שבותנו) שְׁבִיתֵנוּ כַּאֲפִיקִים בַּנֶּגֶב:ה הַזֹּרְעִים בְּדִמְעָה בְּרִנָּה יִקְצֹרוּ:ו הָלוֹךְ יֵלֵךְ וּבָכֹה נֹשֵׂא מֶשֶׁךְ הַזָּרַע בֹּא יָבוֹא בְרִנָּה נֹשֵׂא אֲלֻמֹּתָיו:
נקרא  106  פעמים

אתגר AI

תאומים • אתגר 145

לוח מודעות

למעלה