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

ערב טוב.
לאחר עדכון ה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

@איש-יהודי אתה יכול לקשר את שתי הטבלאות בשאילתה, ואז על אחת השדות בטבלה השניה תכניס קריטריון 'Is Null'.
שים לב כשאתה מקשר להגדיר לו שיביא את כל הרשומות מטבלה 1 ואת הרשומות התואמות מטבלה 2.

עריכה: אתה יכול להכניס עוד קריטריונים כמובן, כמו סינון לפי חודש וכדו'.

@pcinfogmach הייתי ממליץ לך למחוק את התמונה, יש שם יותר מדי פרטים שלך...

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

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

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

@laswater אז ככה.
תוכנת אקסס בנויה בגדול משלושה שלבים, 1. טבלאות, 2. שאילתות, 3. טפסים.
כל הנתונים נשמרים בטבלאות, בשאילתות אפשר ל'שחק' עם הנתונים, והטפסים הם אלו שהלקוח רואה בפועל.
כיון שרוב העדכונים הם בטפסים, מקובל לעשות שיש שתי קבצי אקסס, קובץ אחד שבו נמצאות הטבלאות, וקובץ נוסף שבו נמצאים השאילתות והטפסים.
וכך אפשר לעדכן את הקובץ שבו שמורים הטפסים בלי לפגוע בנתונים.

@ראש-פינה

1. אתה צריך בקיבוץ לפי עיר לעשות כותרת תחתונה, ואז במאפיינים של הכותרת התחתונה 'כפה עמוד חדש' לבחור 'אחרי מקטע'.
2. בתיבת טקסט של המספור שורות במקום 'מעל הכל', לבחור 'מעל קבוצה'.

@hp079 לפי הדוגמא שלך זה הקוד שאתה צריך

Private Sub פקודה16_Click()
Dim DynamicCondition As New Collection

If Not IsNull(ts_active) Then DynamicCondition.Add "פעיל=" & ts_active
If Not IsNull(ts_conected) Then DynamicCondition.Add "מחובר=" & ts_active
If Len(txt_sug) > 0 Then DynamicCondition.Add "סוג='" & CStr(txt_sug) & "'"
If Len(txt_name) > 0 Then DynamicCondition.Add "שם='" & CStr(txt_name) & "'"

DoCmd.OpenReport "דוח1", acViewPreview, WhereCondition:=JoinCollection(DynamicCondition, " AND ")
End Sub

Function JoinCollection(col As Collection, operator As String)
    Dim result As String
    For i = 1 To col.Count
        If i <> 1 Then result = result & operator & " "
        result = result & "(" & col(i) & ") "
    Next
    JoinCollection = result
End Function

הקרדיט כמובן ל @dovid ו @OdedDvir

@mekev תודה.
למעוניינים מצאתי כאן לוח שנה מצוין.

@yossiz גאונות!
תודה!

הצלחתי!!!
השתמשתי בMSXML2.ServerXMLHTTP60 וזה עובד מצוין כולל העברית.
תודה לכולם!

הנה קוד לדוגמא:

Public Function אימות_סניף()
Dim Request As MSXML2.ServerXMLHTTP60
Dim Json As Object
Dim item As Variant

Set Request = New ServerXMLHTTP60
With Request
    .Open "GET", "https://data.gov.il/api/action/datastore_search?resource_id=1c5bc716-8210-4ec7-85be-92e6271955c2&filters={""Bank_Code"":""52"",""Branch_Code"":""172""}", False
    .send
    Set Json = JsonConverter.ParseJson(.responseText)
End With

If Json("success") <> "true" Then
    MsgBox "התרחשה שגיאה, פרטי השגיאה: סוג - " & Json("error")("__type") & ", הודעה - " & Json("error")("message")
ElseIf Json("result")("total") = 0 Then
    MsgBox "הבקשה לא החזירה תוצאות"
Else
    For Each item In Json("result")("records")
        MsgBox item("Bank_Name") & " - " & item("Branch_Name") & " - " & item("Branch_Code")
    Next item
End If

End Function

הערה. אני משתמש בקוד JsonConverter בשביל לקרוא טוב את התשובה.

Public Function Send()
Dim cdoConfig
Dim msgOne
Dim ErrStr

Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
    .item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = 465
    .item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YourEmail@gmail.com"
    .item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YourPasswoed"
    .item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Update
End With

Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig

msgOne.To = "To name <SendTo@gmail.com>"
msgOne.From = "Your Name <YourEmail@gmail.com>"
msgOne.Subject = "Subject"
msgOne.TextBody = "TextBody"
'msgOne.AddAttachment "C:\Users\1\Downloads\Some File.pdf"
msgOne.Send

Exit Function

חיפשת בהיסטוריית ההורדות בדפדפן?

@אוריי לכאו' יש שתי אפשרויות.

1. כמו שיש לך, רק עם סינון כך:

        Dim EditAbsent As Recordset
        Set EditAbsent = CurrentDb.OpenRecordset("select * from [רשימת תורמים] where קוד_תורם = 1")
        
        EditAbsent.Edit
            EditAbsent!נפקד = True
        EditAbsent.Update

2. לעשות פשוט שאילתת עדכון בלי צורך בRecordSet, כך:

Currentdb.Execute "update [רשימת תורמים] set [רשימת תורמים].נפקד = true where קוד_תורם = 1"

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

@סקרן-0 יש גם את זה.
אני חושב שרק המסד נתונים לדוגמא הוא בתשלום סימלי חד פעמי.
ואני הייתי מאוד מרוצה ממנו.

@Y-Excel-Access תודה!
בשביל לקצר תהליכים מצאתי שאפשר להגדיר את זה גם כשעומדים על הטבלת Pivot, בתפריט עיצוב>פריסת דוח>הצג בצורת טבלה, והוא מסדר את הנתונים כמו שאתה הבאת.

@שוהם307 אולי זה יותר מועיל לך.
דוגמא.xlsx

@ArielIzer מצורפת דוגמא עם שתי הבקשות שלך (הוספה וברירת מחדל).
כולל.accdb