使用 vba 从 Internet 链接名称获取 URL

Question

我们每个月都通过单击链接从互联网下载超时表格。

所以我想制作一个 vba 以从站点中的链接名称之一获取 URL。附加图像就是示例。我想获取用红色圈起来的 URL 并粘贴到 excel 中（文件名 otform.xlsm 单元格 A1）。

Answer 1

以下代码将为您提供 google 的第一个搜索结果。
代码会搜索Cell A1中的值，并将搜索结果输入Cell B1中。

Sub GetURL()
    Dim url As String
    Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object

    url = "https://www.google.co.in/search?q=" & Range("A1").Value & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
    XMLHTTP.send

    Set html = CreateObject("htmlfile")
    html.body.innerHTML = XMLHTTP.ResponseText
    Set objResultDiv = html.getelementbyid("rso")
    Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
    Set link = objH3.getelementsbytagname("a")(0)

    Range("B1").Value = link.href
    DoEvents

    MsgBox "Done"
End Sub

我想这就是你想要的。

从here得到这个。

EDIT#1：使用 Internet Explorer ________________________________________________________________________________

Sub GetURL()
    Dim ie As SHDocVw.InternetExplorer  'Requires reference to "Microsoft Internet Controls"
    Dim searchString As String
    Dim lngStartAt As Long, lngResults As Long
    Dim doc As MSHTML.HTMLDocument      'Requires reference to "Microsoft HTML Object Library"
    Dim objResultDiv As Object, objH3 As Object, link As Object

    Set ie = New SHDocVw.InternetExplorer
    lngStartAt = 1
    lngResults = 100

    searchString = Range("A1").Value

    ie.navigate "https://www.google.co.in/search?q=" & searchString
    Do Until ie.readyState = READYSTATE_COMPLETE: DoEvents: Loop

    Set doc = ie.document
    Set objResultDiv = doc.getElementById("rso")
    Set objH3 = objResultDiv.getElementsByTagName("H3")(0)
    Set link = objH3.getElementsByTagName("a")(0)

    Range("B1") = link.href

    ie.Quit
End Sub

您必须从Tools 菜单中添加以下两个References：

1. Microsoft Internet 控件
2. Microsoft HTML 对象库