vba - VBA对象变量或带有 block 变量的未设置错误-Web抓取

Question

因此，我正在编写一些VBA代码来逐步浏览网站，并且不断收到“对象变量或具有未设置错误的块变量”的信息，我通常可以逐步通过代码而没有错误，这使我认为这是一个计时问题。我用等待语句加载了此代码，但仍然会收到该错误。有什么想法吗？我在做疯狂的事吗？

Sub Do_Work_Son()


Dim IE As InternetExplorer
Dim doc As HTMLDocument
Dim plnSelect As HTMLSelectElement 'this selects the plan
Dim adrInput As HTMLInputElement 'this selects the address
Dim dirSelect As HTMLSelectElement 'this selects the distance
Dim strSQL As String
Dim LString As String
Dim LArray() As String

strSQL = "http://avmed.prismisp.com/?tab=doctor"
Set IE = CreateObject("InternetExplorer.Application")

With IE
    .Visible = True
    .navigate strSQL
    Do Until .readyState = READYSTATE_COMPLETE: DoEvents: Loop
       Application.Wait (Now + TimeValue("0:00:5"))

 Set doc = IE.document

        'Call WaitBrowser(IE)

       '-----------------------------
       '--Start Page Select Criteria--
       '-----------------------------

         Set plnSelect = doc.getElementsByClassName("full jqSelectPlan")(0)
         plnSelect.selectedIndex = 1

         Set adrInput = doc.getElementsByClassName("address-type-ahead enteredText ac_input defaultText")(0)
         adrInput.Value = "32258" 'this is where we will link to zip code table

         Set dirSelect = doc.getElementsByName("Proximity")(0)
         dirSelect.selectedIndex = 0


         doc.getElementsByClassName("button large")(0).click 'this submits the initial page
         '------------------------------------------------------
         'Call WaitBrowser(IE)
         Application.Wait (Now + TimeValue("0:00:03"))


         Debug.Print (doc.getElementsByClassName("profileDetails")(0).innerText)


         LString = doc.getElementsByClassName("profileDetails")(0).innerText
         LArray = Split(LString, vbCrLf)

         Debug.Print (LArray(0))


         Application.Wait (Now + TimeValue("0:00:2"))

         Sheet1.Range("A1") = LArray(0)
         Sheet1.Range("B1") = LArray(2)
         Sheet1.Range("C1") = LArray(3)
         Sheet1.Range("D1") = LArray(4)
         Sheet1.Range("E1") = LArray(5)
         Sheet1.Range("F1") = LArray(6)

    End With

End Sub

Answer 1

您有一个等待站点启动的等待循环，而不是按下按钮的循环-您只是设置了任意时间-代码在这里抛出错误吗？

我可以推荐使用MSXML2.ServerXMLHTTP60对象发送GET/POST请求，然后解析html响应，而不是自动化Internet Explorer。

通过以同步方式发送请求，它将等待直到请求完全完成，然后再运行代码的下一部分，这意味着您不必进行“等待循环”或为结果设置随机时间。

我知道这不是您的个别问题的真正答案，但这可能会让您入门:

Sub do_rework_son()
Dim oHTTP As MSXML2.ServerXMLHTTP60
Dim URL As String
Dim myHTMLresult As String
Dim zipCODE As String
Dim myREQUEST As String

Set oHTTP = New MSXML2.ServerXMLHTTP60
URL = "http://avmed.prismisp.com/Search"
zipCODE = "32258"
myREQUEST = "SearchType=ByProvider&ProviderType=Provider&Plan=1&City=&County=&State=&Zip=&Address=" & zipCODE & "&Proximity=5&PrimaryCareProvider=true&Name="

oHTTP.Open "POST", URL, False
oHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oHTTP.send (myREQUEST)

URL = "http://avmed.prismisp.com/ResetFilters"
oHTTP.Open "POST", URL, False
oHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oHTTP.send (myREQUEST)

oHTTP.Open "GET", "http://avmed.prismisp.com/SearchResults?PageRequested=1", False
oHTTP.send

myHTMLresult = oHTTP.responseText

End sub

这个站点有点有趣，需要重新提交相同的信息才能进行第一次搜索(请注意前两个POST请求的URL差异-这是我可以访问搜索结果的唯一方法)。

启动该搜索后，ohttp连接仍处于 Activity 状态，您可以使用更简单的GET请求(该请求仅依赖于URL-该请求无正文字符串)。

GET请求可以浏览结果页面(将URL多次更改为pagerequested = xyz页面，只需通过简单的循环或类似的操作重复两条GET请求行即可遍历所有页面)。

为了获得循环的限制(即结果页的数量)，它们位于html响应的底部附近。

此代码将导航到该网站，提交表单，您可以在“myREQUEST”字符串中替换表单的各个部分(就像我在这里用zipCODE所做的一样，该变量可以更改x次并重新提交代码循环或其他方式)。所有这些都是在没有Internet Explorer的情况下在后台完成的，并且完全否定了任何WAIT功能的使用。

为了解析结果，您可以查看文本字符串响应的字符串处理或将响应加载到html文档中，在其中可以使用getelementsbyID等。

这是我为工作而创建的基本的“仅字符串”解析器(请小心查找包含引号的字符串)

Sub parse_my_example_string()

Dim string_to_parse As String
Dim extracted_info As String

string_to_parse = "<spec tag>Woah!</spec tag><class='this'>This is my result!</class><p>Chicken</p>"

extracted_info = parseResult(string_to_parse, "<class='this'>", "</class>")
MsgBox extracted_info

extracted_info = parseResult(string_to_parse, "<spec tag>", "<")
MsgBox extracted_info

End Sub

Function parseResult(ByRef resStr As String, ByRef schStr As String, ByRef endStr As String)
Dim t1 As Integer: Dim t2 As Integer: Dim t3 As Integer
  If InStr(1, resStr, schStr, vbBinaryCompare) > 0 Then
  t1 = InStr(1, resStr, schStr, vbBinaryCompare) + Len(schStr)
  t2 = InStr(t1, resStr, endStr, vbBinaryCompare)
  t3 = t2 - t1
  parseResult = Mid(resStr, t1, t3)
  End If
End Function

就像我在评论中提到的那样，许多程序员可能不赞成这种做法，但是我发现它对我的工作非常有效，特别是当xml dom文档毫无明显理由使Excel崩溃时!