将文本字符串从网站复制到 Excel VBA

Question

我需要让 VBA 查看网站的 HTML，在文本中找到某个字符串，然后在 Excel 单元格中放置一个包含该字符串的值，以及该字符串左侧的 X 字符，例如 20以身作则。

例如，如果我需要在包含以下字符串的站点中查找字符串“elit”：

Lorem ipsum dolor sit amet，consectetur adipiscing elit。

代码需要将“sectetur adipiscing elit”值返回到指定单元格。即字符串本身，以及字符串左侧的 20 个字符。

这是我到目前为止的想法（我知道 .select 不是最佳做法，但它对我有用）：

Sub String_Checker()
Sheets("Sheet1").Range("a2").Select
Dim IE As Object
Do Until IsEmpty(ActiveCell)
    Set IE = CreateObject("internetexplorer.Application")
    IE.Visible = True
    IE.navigate "https://website.com"
     Do Until (IE.readyState = 4 And Not IE.Busy)
    
          DoEvents
Loop
Set objDoc = IE.document
strMyPage = objDoc.body.innerHTML
Dim s As String: s = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(0, 2).Value = Left(strMyPage, 20)

IE.Quit
ActiveCell.Offset(1, 0).Select
Loop
End Sub

这给了我 HTML 的最后 20 个字符，但我需要让代码开始“查看”指定的字符串，这在 Excel 中始终是 ActiveCell.Offset(0,1).Value。任何帮助，将不胜感激。谢谢！

Answer 1

来自innerHTML的字符串

• 这是一个从上到下的糟糕解决方案，但我的调查导致了它，希望它可以解决问题。

守则

Option Explicit

Sub String_Checker()

' I only ran this from VBE. Sometimes the following error would occur:
' Run-time error '2125463506 (8150002e)':
' The text associated with this error code could not be found.
' I don't know why.
    
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    'IE.Visible = True
    IE.navigate "https://www.wikipedia.com"
    Do Until (IE.readyState = 4 And Not IE.Busy)
        DoEvents
    Loop
    Dim objdoc As Object
    Set objdoc = IE.document
    Dim strMyPage As String
    strMyPage = objdoc.body.innerHTML
    IE.Quit
    
    Const pLeft As Long = 20
    
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")
    
    Dim cel As Range
    Set cel = ws.Range("A2")
    Dim s As String
    Dim pStart As Long
    Dim pLen As Long
    
    Do Until IsEmpty(cel)
        s = cel.Offset(0, 1).Value
        pStart = InStr(1, strMyPage, s, vbTextCompare) - pLeft
        If pStart > 0 Then
        ' The string ('s') was found.
            pLen = InStr(1, strMyPage, s, vbTextCompare) + Len(s) - pStart
            s = Mid(strMyPage, pStart, pLen)
            On Error Resume Next
            ' Here I would receive the following error:
            ' Run-time error '1004': Application-defined or object-defined error
            ' It would occur when the first character would be "=".
            cel.Offset(0, 2).Value = s
            If Err.Number <> 0 Then
                cel.Offset(0, 2).Value = "'" & s ' Maybe this can always be used.
            End If
            On Error GoTo 0
        Else
        ' The string ('s') was NOT found.
        End If
        Set cel = cel.Offset(1)
    Loop

End Sub