Excel VBA从url获取网站标题

Excel VBA 中的 HTML 页面标题 https://stackoverflow.com/questions/7625316/html-page-title-in-excel-vba/14509576#14509576

我知道这已经相当老了，但我对此遇到了困难。我构建了一个浏览器历史解析器，它可以遍历用户计算机（Office）上的 Firefox、IE、Safari 和 Chrome 的历史数据，然后获取不使用此代码的页面的标题。

我从 IE 中收到弹出窗口，即使它应该被隐藏。你想离开这个页面，下载弹出窗口，安装这个ActiveX吗？我必须在它们出现时将其关闭。

有没有办法抑制这些或自动从 VBA 关闭它们？如果我不手动执行此操作，计算机/Excel 最终会停止工作，因为我最终会遇到几个未关闭的 IE 窗口，或者由于无法打开更多 IE 实例而出错。

另外，当我知道 IE 正在打开我一无所知的网站时，我感到非常恶心。我们这个办公室里的感染人数比我以前处理过的都要多。公司软件运行必须使用IE。

有没有更好的方法来做到这一点，或者我们只是该系统的受害者。与 OOo BASIC 相比，MS Office VBA 实际上能做的事情是如此之少，这让我感到震惊。至少在基本功能方面（重新调整阵列大小、FTP 支持）。

请出于对猴子的爱，让有更好的方法。

我也尝试过......

Function fgetMetaTitle(ByVal strURL) As String

Dim stPnt As Long, x As String
Dim oXH As Object
'Get URL's HTML Source
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
    .Open "get", strURL, False
    .send
    x = .responseText
End With
Set oXH = Nothing
'Parse HTML Source for Title
If InStr(1, UCase(x), "<TITLE>") Then
    stPnt = InStr(1, UCase(x), "<TITLE>") + Len("<TITLE>")
    fgetMetaTitle = Mid(x, stPnt, InStr(stPnt, UCase(x), "</TITLE>") - stPnt)
Else
    fgetMetaTitle = ""
End If

End Function

和这个.....

Function getMetaDescription(ByVal strURL As String) As String

'Requires Early Binding Reference to MSHTML Object Library
Dim html1 As HTMLDocument
Dim html2 As HTMLDocument

Set html1 = New HTMLDocument
Set html2 = html1.createDocumentFromUrl(strURL, "")

Do Until html2.readyState = "complete": DoEvents: Loop

getMetaDescription = html2.getElementsByTagName("meta").Item("Description").Content

Set html2 = Nothing
Set html1 = Nothing

End Function

下界已经起作用了。

尝试这个。在 MS Excel 2010 中对我来说工作得很好

Dim title As String
Dim objHttp As Object
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open "GET", "http://www.google.com/", False
objHttp.Send ""

title = objHttp.ResponseText

If InStr(1, UCase(title), "<TITLE>") Then
    title = Mid(title, InStr(1, UCase(title), "<TITLE>") + Len("<TITLE>"))
    title = Mid(title, 1, InStr(1, UCase(title), "</TITLE>") - 1)
Else
    title = ""
End If

MsgBox title