ربط النموذج بموقع http://www.cbe.org.eg/Arabic/

السلام عليكم ورحمة الله وبركاته

الموضوع ببساطة اننا عايزين نعمل كائن جديد ونستخدم فيه الانترنت اكسبلور ويروح الكائن ده يفتح صفحة انترنت معينة ويقوم يدور في صفحة الانترنت المعينة عن جدول معين "جدول اسعار العملات" وبعدين يبدأ ينقل البيانات من جدول الاسعار لجدول في الاكسيس.

علشان ابدا الموضوع لازم الاول افتح الموقع المطلوب في اي متصفح عندي وادخل علي كود HTML الخاص بالصفحة علشان اجيب ID بتاع الجدول اللي انا حشتغل عليه؛ والـ ID اللي انا حشتغل عليه في الموقع اللي انت طلبته بالشكل ده:
"_ctl0_MainContant_ArabicExchangeRates1_CurrencyRatesList"

أتفضل الكود مشروح وكذلك مرفق ملف في المرفقات والكود شغال علي زر الامر الموجود "جلب أسعار اليوم"

' نقوم في بداية الامر بوقف التحذيرات علشان لما ننقل القيم داخل الجدول ميظهرش رسائل تنبيه
DoCmd.SetWarnings False

' مجرد نقل تركيز علي مربع المسلسل علشان لما نيجي نضيف سجل جديد نتأكد أنه تم أضافته بشكل سليم 
Forms!Table01!Id.SetFocus
DoCmd.GoToRecord , , acNewRec


' تعريفات المتغيرات اللي حنشتغل بيها
    Dim Internet As Object
    Dim InternetData As Object
    Dim Link As Object
    Dim URL As String
    Dim Elements As Object
    

' ننشئ كائن جديد ونستخدم فيه متصفح الانترنت
    Set Internet = CreateObject("InternetExplorer.Application")
    'internet.Visible = True

' نحدد أسم الموقع اللي عايزين نفتحه في المتصفح.. ملحوظة تم اضافة الوقت الحالي في نهاية العنوان علشان الاكسبلور اوقات بيكيش الصفحة
' كده نضمن ان كل مرة الاكسلبلور حيفهم اني طالب صفحة جديدة مش موجودة في الكاش عنده
    URL = "http://www.cbe.org.eg/Arabic/default.html"
    URL = URL & "?a=" & Now()
    Internet.Navigate URL

' أتاكد من تحميل الصفحة بشكل سليم
    Do Until Internet.ReadyState >= 4
        DoEvents
    Loop


' ابداء ملسلسل الشقاء والمناعة والبحث في الصفحة عن الجداول اللي موجوده فيها 
        Set InternetData = Internet.Document
        Set SelectTablesInHTML = InternetData.getElementsByTagName("table")
        
                     
            For Each TablesDataInHTML In SelectTablesInHTML
            
' لو وجد جدول بالاسم اللي انا عايزه يقفش فيه بسرعه 
                    If TablesDataInHTML.Id = "_ctl0_MainContant_ArabicExchangeRates1_CurrencyRatesList" Then
                    
                    
' أول حاجة يبدأ يضيف سجل جديد علشان نبدأ نملي المتغيرات بقيم علشان ندخلها جوه الجدول
                    [Date] = Format(Now(), "yyyy-mm-dd")
                    DoCmd.Save
                    Me.Requery
                    DoCmd.GoToRecord , , acLast
' اطلب منه انه يبدأ يحدد صفوف الجدول ويبدأ يدخلها في متغيرات .. وهنا لازم يكون في واقفة
' انا عايز منه يملي سطر سطر من الموقع الي جدول في الاكسيس 
' بس انا لو كل مرة عملت استعلام الحاق كده حيبقي كل قيمة في سجل 
' يعني في اول سجل حيقي في قيمة دولار 
' وتاني سجل قيمة سعر الدولار للصرف
' وتالت سجل قيمة سعر الدولاؤ للبيع .. بس انا مش عايز كده 
' حبدأ اشتغل أني اعمل شوية متغيرات تتعبي بالبيانات واول ما اكمل الي 3 صفوف اشغل استعلام الالحاق

' في الجدول اللي هو قفش فيه يبدأ يدور علي أول صف فيه علشان يشتغل بقا وكفاية كسل 

                            Set Elements = TablesDataInHTML.getElementsByTagName("td")
                                
                                    TheValue = 1
                                    Dim one, two, three As Double
                                    
                                For Each Element In Elements
                                
                                                            If TheValue > 3 Then
                                                                TheValue = 1
                                                            End If
                                    
                                    If TheValue = 1 Then
                                        one = Element.innerText
                                    End If
                                
                                    If TheValue = 2 Then
                                        two = Element.innerText
                                    End If
                                    
                                    If TheValue = 3 Then
                                        three = Element.innerText
                                    End If
                                    
                                                            If TheValue = 3 Then
                                                            DoCmd.RunSQL "INSERT INTO Table02 ( id, Teep, [In], Out ) SELECT '" & Me.Id & "' AS IDDD, '" & one & "' AS TheFirstValue, '" & two & "' AS TheTwoValue, '" & three & "' AS ThethereValue;"
                                                            End If
                                    
                                    TheValue = TheValue + 1
                                    
                                    
                                Next
                    End If
                    
            Next

' أقفل الكائن اللي انا فاتحه علشان الجهاز ميتقلش.. وياريت لو الجهاز هنج معاك تفتح التاسك مانجر وتقفل الاكسبلور عافية :D 
    Internet.Quit
    Set Internet = Nothing
    
   ' أشغل التنبيهات تاني علشان انا معملتش حاجة :D  
    DoCmd.SetWarnings True

رسالة خفيفة انه خلص المهمه بتاعتي 
        Me.Refresh
    Me.Requery
    
    MsgBox "done"
    DoCmd.GoToRecord , , acLast

أنا غيرت نوع البيانات في جدول البيانات؛ حولته من عملة إلي رقم علشان كان في شوية مشاكل في استعلام الترحيل؛ وأفتكر أنها مش مشكلة

أتفضل المرفقات

db1_1.rar

لا تنسنا من صالح الدعاء