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

Question

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

所以我想创建一个vba来从站点中的一个链接名称获取URL。附加图像就是一个例子。我希望将URL包围为红色并粘贴到excel（文件名otform.xlsm单元格A1）。

Answer 1

下面的代码将为您提供谷歌的第一个搜索结果 代码将在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。

编辑＃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

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

1. Microsoft Internet Controls
2. Microsoft HTML对象库