بازیابی داده های جستجوی وب بدون وقفه

Question

نیکولاس یک پرس و جو وب برای بازیابی داده های خارجی به طور منظم ایجاد کرده است. مشکل این است که او اغلب هنگام اجرای پرس و جو وب پیغام خطای "Unable to open the web page..." را دریافت می کند. این پیام زمانی ظاهر می شود که اتصال اینترنتی بین نیکولاس و وب سرور قطع شود و او باید روی پیام خطا روی OK کلیک کند تا اکسل ادامه یابد.

هنگامی که نیکولاس از رایانه خود دور است، این مشکل ایجاد می کند، زیرا ممکن است به این معنی باشد که کوئری وب تمام داده هایی را که باید جمع آوری کند را جمع آوری نمی کند، زیرا وقتی با مشکلی مواجه می شود، صبورانه منتظر کلیک روی دکمه تأیید است. نیکولاس راهی می خواهد که به درخواست وب بگوید پیام را نمایش ندهد و اگر در تلاش فعلی امکان اتصال برقرار نشد، فقط به حالت انتظار برگردد.

متأسفانه هیچ راهی وجود ندارد که به اکسل بگوییم آنچه را که می خواهید انجام دهد. هنگامی که پیام "Unable to open the web page..." ظاهر می شود، سرکوب پیام عملا غیرممکن است. تنها راه حل این است که سعی کنید یک ماکرو ایجاد کنید که در اطراف مشکل کار کند. به عنوان مثال، می توانید یک ماکرو ایجاد کنید که یک نمونه از اینترنت اکسپلورر (که مشکلی ندارد) ایجاد کند تا خطای رسیدن به صفحه وب را آزمایش کند. ماکرو زیر این رویکرد را پیاده سازی می کند.

Option Explicit
Declare Sleep API
Private Declare Sub Sleep Lib "kernel32" (ByVal nMilliseconds As Long)

Function GetData(strStartURL As String) As String
    Dim Attempt As Long
    Dim Connected As Boolean
    Dim ieDocNew As MSHTML.HTMLDocument

    GetData = "N/A"
    Attempt = 0

retry:
    Attempt = Attempt + 1

    Create browser object references and open an IE window
    Dim ieNew As New InternetExplorer
    Load page
    With ieNew
        .Visible = True       show window
        .navigate strStartURL open page
        While Not .readyState = READYSTATE_COMPLETE
            Sleep 500         wait 1/2 sec before trying again
        Wend
    End With

    The page should be open in IE, time for parsing
    Create document object model references
    Set ieDocNew = ieNew.Document

    If ieDocNew.Scripts.Length = 13 _
      And ieNew.LocationName = "Microsoft Excel Tips" _
      Then
        Connected = True
        GetData = "Data successfully captured"

        This is where you do something with the data
    End If

    Clean up IE objects
    Set ieDocNew = Nothing
    ieNew.Quit
    Set ieNew = Nothing
    DoEvents
    If Attempt < 10 And Not Connected Then GoTo retry
End Function

توجه داشته باشید که این ماکرو برای عملکرد صحیح نیاز به پیکربندی در رابط VBA دارد. به طور خاص، باید References را از منوی Tools انتخاب کنید و مطمئن شوید که پروژه شامل ارجاعاتی به Microsoft HTML Object Library و Microsoft Internet Controls است.

کاری که ماکرو انجام می دهد این است که از اینترنت اکسپلورر برای اتصال به URL ارسال شده به تابع (در strStartURL) و سپس گرفتن محتوایی که در آنجا یافت می شود استفاده می کند. اگر اتصال موفقیت آمیز باشد، Connected روی True تنظیم می شود و می توانید داده ها را در سایت تجزیه و استفاده کنید. این تابع، همانطور که نوشته شده است، «داده ها با موفقیت ضبط شد» را به روال فراخوانی برمی گرداند، اما شما می توانید به همین راحتی مقداری را که از سایت راه دور گرفته شده است، پس دهید. سپس می توان آن مقدار را، اما روال فراخوانی، در یک کاربرگ قرار داد.

همچنین توجه داشته باشید که این تابع مقداری تجزیه اولیه را در صفحه ای که می گیرد انجام می دهد و فقط در صورتی اتصال را موفق می داند که عبارات مورد انتظار را در عنوان صفحه موجود در URL پیدا کند.

برای درک نحوه عملکرد ماکرو، از چند ماکرو مانند زیر استفاده کنید:

Sub TEST_GetData1()
    MsgBox GetData("http://excel.tips.net")
End Sub

Sub TEST_GetData2()
    MsgBox GetData("http://excel.tipsxx.net")
End Sub

Sub TEST_GetData3()
    MsgBox GetData("http://excel.tips.net/junk")
End Sub

اولی باید کار کند. دو مورد دوم باید پیامی را نشان دهند که می گوید "N/A".