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

FullTime · 31/12/13

יש כאן קוד.

דבר ראשון, תודה רבה מוישי.
אני משתמש עם הפונקציה הזאת GetBankOfIsraelExchangeRate ?

הוא מחזיר שגיאה 13 של אי התאמת סוג והפונקציה הנ"ל מקבלת ערך 0
איך אני אמור להשתמש איתו, אולי הבעיה בי....

moishy · 31/12/13

תוקן במקור.

FullTime · 31/12/13

תודה רבה רבה, עובד מצויין

יאיר משה · 1/1/14

איך משתמשים בפונקציה זאת?
תודה

FullTime · 1/1/14

דוגמה:
לחצן 'קבל שער הדולר'
תיבת טקסט 'טקסט0'

הגדרת הלחצן 'בעת לחיצה'

קוד:

טקסט0 = GetBankOfIsraelExchangeRate()

moishy · 2/1/14

הנה גרסא משופרת ובו כמה תיקונים

קוד:

Option Explicit

Public Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean

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 pos As Long
    Dim strSearch As String
    Dim dtPreviousDate As Date
    Dim i As Integer

    strSearch = Chr(60) & "RATE" & Chr(62)

    If dtDate = #1/1/1900# Then
        dtDate = Date
    End If

    Select Case strCurr
        Case "01", "02", "03", "05", "06", "12", "17", "18", "27", "28", "31", "69", "70", "79"
        Case Else
            MsgBox "קוד מטבע לא חוקי!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
            Exit Function
    End Select

    If IsConnected Then
        strURL = "http://www.boi.org.il/currency.xml?rdate=" & Format(IIf(dtPreviousDate > 1, dtPreviousDate, dtDate), "YYYYMMDD") & "&curr=" & strCurr
        strResult = GetHTML(strURL)
        If InStr(1, strResult, strSearch) < 1 Then
            For i = 1 To 6
                dtPreviousDate = dtDate - i
                strURL = "http://www.boi.org.il/currency.xml?rdate=" & Format(dtPreviousDate, "YYYYMMDD") & "&curr=" & strCurr
                strResult = GetHTML(strURL)
                If InStr(1, strResult, strSearch) > 0 Then Exit For
            Next i
        End If
    Else
        MsgBox "לא זוהה חיבור לאינטרמת!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
    End If

    If Len(strResult) > 0 Then
        pos = InStr(1, strResult, strSearch, vbTextCompare)
        If pos > -1 Then
            GetNISExchangeRate = Mid(strResult, pos + Len(strSearch), 5)
        End If
    End If
    
End Function

Function IsConnected() As Boolean
    Dim Stat As Long
    IsConnected = (InternetGetConnectedState(Stat, 0&) <> 0)
End Function

Function GetHTML(strURL As String) As String
    Dim HTML As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", strURL, False
        .Send
        GetHTML = .ResponseText
    End With
End Function

FullTime · 2/1/14

מה השדרוג שלו, לפי מה שנראה לי, לפני נסיון, אפשר לבחור מטבע?

moishy · 2/1/14

גם בגירסא הקודמת אפשר לבחור תאריך ומטבע.

להלן השינויים:

1. בדיקה שקוד המטבע תקין, אם לא - יציאה מהפוקציה.
2. dtPreviousDate > 1 במקום Not IsNothing(dtPreviousDate).
3. הוספת vbMsgBoxRtlReading + vbMsgBoxRight לMsgBox

HUBHCBH · 2/1/14

למה לא מסתדר לי?

moishy · 2/1/14

תוקן.

HUBHCBH · 2/1/14

איך אני קורא לפונקציה של דולר?

moishy · 2/1/14

שיניתי את שם הפונקציה, כיון שלמען הדיוק הוא מציג רק את השערים ביחס לשקל. שם הפונקציה היא .GetNISExchangeRate

יאיר משה · 6/1/14

תודה רבה

עובד נהדר, כל הכבוד!!

יאיר משה · 23/1/14

בכל מחשב שאני פותח את הפונקציה הזאת יש הודעת שגיאה.
אולי מישהו יודע למה?
תודה

moishy · 23/1/14

מה הודעת השגיאה?

יאיר משה · 23/1/14

צרפתי
תודה.

moishy · 23/1/14

תשנה את הספרה 5 בסוף השורה ל 4.

יאיר משה · 23/1/14

אין צורך לשנות, זה חזר לעבוד.
כנראה היתה בעיה באתר בנק ישראל.
תודה רבה מאוד.

moishy · 23/1/14

כנראה שלא היתה זו בעיה בבנק ישראל אלא בפונקציה, הפונקציה בנויה למשוך את השער שהוא בדר"כ 5 תווים (שלם, נקודה עשרונית ושלש מקומות לאחר הנקודה), במקרה והשער מכיל פחות ממספר תוים זה, נתקל בבעיה שמצאת.
לפתור את זה, מומלץ למחוק את ה As Double מסוף השורה הראשונה של הפונקציה, כך יתכן שערך המוחזר לא יהיה רק מספר, אבל לא נתקל בשגיאה.

moishy · 23/1/14

לחילופין ניתן (ורצוי להשתמש בגירסה זו)

קוד:

Option Explicit

Public Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean

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 pos As Long
    Dim strSearch As String
    Dim dtPreviousDate As Date
    Dim i As Integer

    strSearch = Chr(60) & "RATE" & Chr(62)

    If dtDate = #1/1/1900# Then
        dtDate = Date
    End If

    Select Case strCurr
        Case "01", "02", "03", "05", "06", "12", "17", "18", "27", "28", "31", "69", "70", "79"
        Case Else
            MsgBox "קוד מטבע לא חוקי!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
            Exit Function
    End Select

    If IsConnected Then
        strURL = "http://www.boi.org.il/currency.xml?rdate=" & Format(IIf(dtPreviousDate > 1, dtPreviousDate, dtDate), "YYYYMMDD") & "&curr=" & strCurr
        strResult = GetHTML(strURL)
        If InStr(1, strResult, strSearch) < 1 Then
            For i = 1 To 6
                dtPreviousDate = dtDate - i
                strURL = "http://www.boi.org.il/currency.xml?rdate=" & Format(dtPreviousDate, "YYYYMMDD") & "&curr=" & strCurr
                strResult = GetHTML(strURL)
                If InStr(1, strResult, strSearch) > 0 Then Exit For
            Next i
        End If
    Else
        MsgBox "לא זוהה חיבור לאינטרמת!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
    End If

    If Len(strResult) > 0 Then
        pos = InStr(1, strResult, strSearch, vbTextCompare)
        If pos > -1 Then
            GetNISExchangeRate = ExtractNumber(Mid(strResult, pos + Len(strSearch), 5))    ' / 1000
        End If
    End If

End Function

Function IsConnected() As Boolean
    Dim Stat As Long
    IsConnected = (InternetGetConnectedState(Stat, 0&) <> 0)
End Function

Function GetHTML(strURL As String) As String
    Dim HTML As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", strURL, False
        .Send
        GetHTML = .ResponseText
    End With
End Function

Function ExtractNumber(strText As String)
    Dim iCount As Integer, i As Integer
    Dim lNum As String

    For iCount = Len(strText) To 1 Step -1
        If IsNumeric(Mid(strText, iCount, 1)) Then
            i = i + 1
            lNum = Mid(strText, iCount, 1) & lNum
        Else
            If Mid(strText, iCount, 1) = Chr(46) Then
                i = i + 1
                lNum = Mid(strText, iCount, 1) & lNum
            End If
        End If
        If i = 1 Then lNum = CDbl(Mid(lNum, 1, 1))
    Next iCount

    ExtractNumber = CDbl(lNum)
End Function

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

משתמש מקצוען

משתמש סופר מקצוען

משתמש מקצוען

משתמש פעיל

משתמש מקצוען

משתמש סופר מקצוען

משתמש מקצוען

משתמש סופר מקצוען

משתמש מקצוען

קבצים מצורפים

משתמש סופר מקצוען

משתמש מקצוען

משתמש סופר מקצוען

משתמש פעיל

משתמש פעיל

קבצים מצורפים

משתמש סופר מקצוען

משתמש פעיל

קבצים מצורפים

משתמש סופר מקצוען

משתמש פעיל

משתמש סופר מקצוען

משתמש סופר מקצוען

אשכולות דומים

תקווה לעתיד טוב יותר • אתגר 17

תגיות נפוצות