从 Excel 中的 URL 列表生成网页标题答案

【问题标题】：Generate Webpage Titles from List of URLs in Excel从 Excel 中的 URL 列表生成网页标题
【发布时间】：2014-03-27 00:12:10
【问题描述】：

我在 Excel 中有一个网站 URL 列，并希望自动检索每个 URL 的网页标题并将它们放在第二个对应的列中。

我没有任何使用 VBA 的经验，但我想使用 VBA 来做到这一点。有人可以一一列出完成这项工作的步骤吗？我在哪里粘贴什么代码？如何将代码指向正确的列以获取 URL，以及如何告诉它在哪里填充结果？如何运行代码？

我认为这是一个流行的问题，但许多人不使用现有的文档来解决它，因为他们和我有同样的问题——他们不知道如何加载和运行脚本。

任何帮助将不胜感激！请尽可能详细。

【问题讨论】：

谷歌搜索给了我很多点击，例如 stackoverflow.com/questions/7625316/… 或 stackoverflow.com/questions/14514181/… 尝试使用其中一种方法，如果遇到问题，请回复您的代码。
我将该代码粘贴到一个模块中，但我没有看到一种方法来告诉它要读取哪一列以及输入哪一列。当我运行代码时，什么也没有发生。这就是为什么我希望为那些不精通 VBA 的人逐个播放
关于如何告诉它读取哪一列（哪一列包含域名）以及输出到哪一列（结果标题？感谢您的帮助！

标签： vba url excel title

【解决方案1】：

调整“A1:A10”范围以匹配您的数据....

Sub GetTitles()
    Dim c As Range, url As String
    For Each c In Range("A1:A10").Cells
        url = Trim(c.Value)
        If LCase(url) Like "http://*" Then
            c.Offset(0, 1).Value = GetTitle(url)
        End If
    Next c
End Sub

Function GetTitle(sURL As String)
    Dim title As String, res As String, pos1, pos2
    Dim objHttp As Object
    Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
    objHttp.Open "GET", sURL, False
    objHttp.Send ""

    res = objHttp.ResponseText
    pos1 = InStr(1, UCase(res), "<TITLE>")
    pos2 = InStr(1, UCase(res), "</TITLE>")

    title = "<not found>"
    If pos1 > 0 And pos2 > 0 Then
        pos1 = pos1 + Len("<TITLE>")
        title = Mid(res, pos1, pos2 - pos1)
    End If
    GetTitle = title
End Function

【讨论】：