时间戳

首页 > 解决方案 > 打开链接并在链接中搜索动态关键字的 VBA 代码

excel - 打开链接并在链接中搜索动态关键字的 VBA 代码

问题描述

我一直在对此进行大量研究，但我似乎无法确切弄清楚如何解决我的问题。在 N:N 列中，我有数百个要循环和打开的链接。代码打开它们后，我有另一个工作表，其中包含我希望代码在搜索每个单独的链接时引用的单词/短语的动态列表。如果代码在页面中找不到任何内容，它会关闭窗口并转到下一个链接。如果它确实找到匹配项（不需要区分大小写），那么它会复制相应 O:O 单元格中的所有单词/短语，每个单元格都用“;”分隔。

根据我的研究，我有这段代码可以打开链接：

Dim ie As Object   
Set ie = CreateObject("InternetExplorer.Application") 
ie.Visible = True   
Dim x As Integer 
Dim links As Hyperlinks 
Set links = ActiveSheet.Hyperlinks  
For x = 1 To links.Count 
    ie.navigate links.Item(x).Address, Nothing, "_blank"
Next

但是，我似乎找不到任何东西可以帮助我处理这段代码的最后一部分。我对 VBA 相当熟悉，但这超出了我的技能范围。

提前谢谢你！

标签： excelvbainternet-explorernavbar

解决方案

要在网页中搜索关键字或文本，您可以参考下面的代码示例。

Sub scraper()

        Dim site As String
        Dim lastRow As Long
        Dim ie

        With ActiveSheet
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With

            Set ie = CreateObject("internetexplorer.application")
            ie.Visible = True

            ie.navigate site

            'idle while ie is busy
            Do
            Loop Until ie.readystate = 3
            Do
            Loop Until ie.readystate = 4

            With ie.document
                .getelementbyid("UserName").Value = uName
                .getelementbyid("Password").Value = uPass
                .forms(0).submit
            End With
            On Error GoTo error

            Do
            Loop Until ie.readystate = 3
            Do
            Loop Until ie.readystate = 4

            For i = 2 To lastRow

                site = Range("A" & i).Value
                ie.navigate site

            Do
            Loop Until ie.readystate = 3
            Do
            Loop Until ie.readystate = 4


        msg = ie.document.Body.innerhtml
        If InStr(msg, "Text To Find") = 0 Then
            ActiveSheet.Range("B" & i).Value = "Not Found"
        Else
            ActiveSheet.Range("B" & i).Value = "Found"
       End If
jump:
            Next i
        Exit Sub
error:
    ActiveSheet.Range("B" & i).Value = "Unknown Error!"
Resume jump


End Sub

这是示例代码，您可以尝试根据自己的要求对其进行修改。

参考：

在网页中搜索特定文本

对于将值从一个单元格复制粘贴到另一个单元格，您可以参考下面的链接可能会给您一个想法。

仅使用 VBA 复制和粘贴特殊值的最佳方法

推荐阅读