vba - 使用vba从网络检索数据

Question

刚刚开始使用 html，在 vba 中相当有能力，但在链接两者时遇到一些问题。

我已通过网站注册并尝试获取结果。 到目前为止使用的代码

Dim HTMLDoc As HTMLDocument
 Dim MyBrowser As InternetExplorer
  Sub GetVehicleDetails()

  Dim MyHTML_Element As IHTMLElement
  Dim MyURL As String
  Dim x As Integer
  On Error GoTo Err_Clear
  MyURL = "http://www.1stchoice.co.uk/find-a-part"
  x = 0
  Set MyBrowser = New InternetExplorer
  MyBrowser.Silent = True
  MyBrowser.navigate MyURL
  MyBrowser.Visible = True
  Do
  Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
  Set HTMLDoc = MyBrowser.document
  HTMLDoc.all.license_plate.Value = "LV11VYT"

  For Each MyHTML_Element In HTMLDoc.getElementsByTagName("button") '("input")
  'Get 2nd button
   If MyHTML_Element.Title = "Continue" Then 'MyHTML_Element.Click: Exit For
    x = x + 1
    If x = 2 Then
    MyHTML_Element.Click
    End If
   End If
  Next
Err_Clear:
  If Err <> 0 Then
  Err.Clear
  Resume Next
  End If
  End Sub

现在我需要等到页面刷新然后获取结果，但我不知道如何提取结果

源代码为

<div id="block_subheader" class="block_editable block_wysiwyg">
<p>Almost there! <strong>TELL US</strong>&nbsp;which parts you need - <strong>ADD&nbsp;</strong>your contact details &amp; receive <strong>No Obligation Quotes</strong><span style="font-weight: normal;">&nbsp;to compare &amp; </span><span style="font-weight: normal;"><strong>Save &pound;&pound;'s!</strong></span></p>                      
</div>
<div class="clear"></div>
<form id="step3" action="/find-a-part/step-3" method="post" enctype="multipart/form-data">
<div class="clearfix">
<h2>RENAULT MEGANE (X95) DYNAMIQUE TOMTOM DCI ECO 3 DOOR COUPE 1461cc (2011) DIESEL</h2>
<p><a href="/find-a-part/step-2">Not quite the vehicle you're searching for? Click here to specify the vehicle exactly</a></p>
</div>

尝试获取雷诺梅甘娜详细信息

有人可以帮忙吗？

好的，我已经通过了这一部分，但遇到了另一个问题，当单击按钮后页面发生变化时，我需要将 html.document 更新到新页面，因为当我在代码中使用它时，它会拉出旧源代码。

我可以让它工作，但它仅适用于激活消息框以说出浏览器名称是什么。

有什么建议吗？

Dim HTMLDoc As HTMLDocument
 Dim MyBrowser As InternetExplorer

Sub GetVehicleDetails2()

  Dim MyHTML_Element As IHTMLElement
  Dim HTMLDoc As HTMLDocument, Doc As HTMLDocument
  Dim MyURL As String, Vehicle As String
  Dim x As Integer, y As Integer
  On Error GoTo Err_Clear
  MyURL = "http://www.1stchoice.co.uk/find-a-part"
  x = 0
  'open new explorer
  Set MyBrowser = New InternetExplorer
  MyBrowser.Silent = True
  'navigate to page
  MyBrowser.navigate MyURL
  MyBrowser.Visible = True
  'wait until ready
  Do While MyBrowser.Busy Or _
  MyBrowser.readyState <> 4
  DoEvents
  Loop
  Do
  Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
    Set HTMLDoc = MyBrowser.document

    'enter registration in text box
    HTMLDoc.all.license_plate.Value = "LV11VYT"

    'click continue button
    Set MyHTML_Element = HTMLDoc.getElementsByTagName("button")(1)
    MyHTML_Element.Click
    Set HTMLDoc = Nothing
    'wait until page updated

    Set Doc = MyBrowser.document
    'Application.Wait (Now() + "00:00:05")

    'does not work if you take this out
    MsgBox MyBrowser.FullName

    'find text returned with vehicle details
    For Each MyHTML_Element In Doc.getElementsByTagName("form")
      If MyHTML_Element.ID = "step3" Then
        Vehicle = MyHTML_Element.innerText
        MsgBox Vehicle
      End If
    Next
  'close browser down
 'MyBrowser.Quit

Err_Clear:
  If Err <> 0 Then
  Err.Clear
  Resume Next
  End If
  End Sub

使用 2003 或 2007，尝试过网络查询，无法传递值并使用继续按钮。

Answer 1

无需尝试使用正则表达式(相对于解析器)从 HTML 中提取元素，但正则表达式将是提取所需元素的简单方法，因为它定义良好，并且您只需要该元素。

你可以做类似的事情(我提供了一种仅使用 InStr 的替代方法，这适用于你的示例，但如果一次返回大量结果或语法更改等，那么正则表达式会更灵活):

Sub blah()

    Dim testStr As String

    'test string you provided in the Question -> substitute it for your HTML return
    testStr = ActiveSheet.Cells(1, 1).Value

'Method 1: Use a simple Instr (fine for the example you provided, but if different bits you need to search are more complicated then you may need to use Regex instead

    Dim startLocation As Long, endLocation As Long
    Dim extractedText As String

    startLocation = InStr(1, testStr, "<h2>", vbTextCompare)

    If Not startLocation > 0 Then

        Exit Sub 'or move to next or whatever

    Else

        endLocation = InStr(startLocation, testStr, "</h2>", vbTextCompare)

        extractedText = Mid(testStr, startLocation + 4, endLocation - startLocation - 4)

        Debug.Print "Basic InStr method: "; extractedText

    End If

'Method 2: Use Regex

    'more flexible -> reference a Regex engine.
    'This example uses Microsoft VBScript Regular Expressions 5.5
    'That engine uses the same syntax as MS JavaScript regex
    'See http://msdn.microsoft.com/en-us/library/1400241x.aspx for syntax

    Dim regex As RegExp
    Dim match As match

    Set regex = New RegExp

    With regex

        .Pattern = "(?:<h2>)([\s\S]*?)(?=</h2>)"
        'NB this regex engine does not support lookbehinds :-(
        'so we have to extract the submatched group for what we want
        '(vs. just using Match.Value)
        .IgnoreCase = True
        .MultiLine = True

        For Each match In .Execute(testStr)

            Debug.Print "Regex match: "; match.SubMatches.Item(0)

        Next match

    End With

End Sub

输出是:

Basic InStr method: RENAULT MEGANE (X95) DYNAMIQUE TOMTOM DCI ECO 3 DOOR COUPE 1461cc (2011) DIESEL
Regex match: RENAULT MEGANE (X95) DYNAMIQUE TOMTOM DCI ECO 3 DOOR COUPE 1461cc (2011) DIESEL