Question

所以我正在编写一些VBA代码来逐步浏览一个网站，我不断得到一个“对象变量或块变量没有设置错误”我通常可以顺利执行代码而没有错误，这让我相信这是一个时间问题。我用wait语句加载了这段代码，仍然会得到错误。有什么想法吗？我在疯狂吗？

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。

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

我知道这不是你个人问题的真正答案，但这可能会让你开始：

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连接仍然有效，您可以使用更简单的GET请求（仅依赖于URL - 请求没有正文字符串）。

GET请求可以导航结果页面（根据需要多次将URL更改为pagerequested = xyz页面，只需通过一个简单的循环或其他内容重复两个GET请求行，即可浏览所有页面）。 / p>

为了获得循环的限制，即结果页面的数量，它们接近html响应的底部。

此代码将导航到网站，提交表单，您可以在＆＃34; myREQUEST＆＃34;中替换表单的各个部分。 string（因为我在这里用zipCODE完成，这是一个变量，你可以改变x次，然后重新提交循环中的代码或者其他）。这一切都是在后台完成的，没有Internet Explorer，完全否定了任何WAIT函数的使用。

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

这里只是一个基本的＆＃34;仅限字符串＆＃34;我为工作创建的解析器（小心找到包含引号的字符串）

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时！

Answer 2

我在这里看到一些问题。

一个是等待就绪状态完成的循环由于某种原因继续打开。我会把这条线拿出来

Do Until .readyState = READYSTATE_COMPLETE: DoEvents: Loop

因为我不认为这是必要的。

您没有将Sheet1设置为任何内容，我怀疑这是您的代码实际上发生错误的地方。试试这个

Set Sh1 = Worksheets("Sheet1")

并使用新引用Sh1来引用该工作表。

此阵列中没有7个元素

LArray = Split(LString, vbCrLf)

也许你永远不会知道你将拥有多少元素。在那种情况下，我会这样做

For i = LBound(LArray) to UBound(LArray)
    Sh1.Cells(1, i+1) = LArray(i)
Next i

而不是

 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)

以下是我的代码，其中包含以上所有更改：

Sub Do_Work_Son()

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:10"))

 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"))



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

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

     Set Sh1 = Worksheets("Sheet1")

     For i = LBound(LArray) To UBound(LArray)
         Sh1.Cells(1, i + 1) = LArray(i)
     Next i

    End With

End Sub

你会注意到我为你的页面加载了比以前多一点的时间。 5秒可能还不够。如果10还不够，请添加更多内容，但这似乎是一个加载速度相当快的页面。

希望这有帮助。

VBA对象变量或块变量未设置错误 - Web抓取

2 个答案: