vba Excel VBA从url获取网站标题
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14514181/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA to get website Title from url
提问by Justin W
I know that this is fairly old but I'm having difficulty with this. I've built a browswer history parser that goes through the history data from Firefox, IE, Safari, and Chrome on our users computers (Office) and then it gets titles for pages that don't using this code.
我知道这已经很老了，但我对此有困难。我已经构建了一个浏览器历史解析器，它通过我们用户计算机 (Office) 上来自 Firefox、IE、Safari 和 Chrome 的历史数据，然后获取不使用此代码的页面的标题。
I get popups from IE even though it should be hidden. Do you want to leave this page, download popups, install this ActiveX this or thats that I have to close out as they come up.
我从 IE 中得到弹出窗口，即使它应该被隐藏。你想离开这个页面，下载弹出窗口，安装这个 ActiveX 这个或那个我必须在它们出现时关闭。
Is there a way to suppress those or automatically close those from VBA? If I don't do it by hand the computer/Excel eventually stops working as I end up with several unclosed IE windows or it errors out because it can't open anymore IE instances.
有没有办法从 VBA 中抑制或自动关闭那些？如果我不手动完成，计算机/Excel 最终会停止工作，因为我最终会遇到几个未关闭的 IE 窗口，或者由于无法再打开 IE 实例而出错。
Plus I feel pretty sick knowing that IE is opening sites that I don't know anything about. We have more infections in this office than I have ever had to deal with before. We have to use IE for the company software to run on.
另外，知道 IE 正在打开我一无所知的网站，我感到很不舒服。我们办公室里的感染人数比我以前处理的还要多。我们必须使用 IE 来运行公司软件。
Is there a better way of doing this or are we just victims of the system. I'm just awestruck at how little can actually be done in MS Office VBA compared to OOo BASIC. At least basic feature wise (redimensioning arrays, FTP support).
有没有更好的方法来做到这一点，或者我们只是系统的受害者。与 OOo BASIC 相比，在 MS Office VBA 中实际上可以做的事情实在是太少了，我对此感到震惊。至少在基本功能方面（重新调整数组，FTP 支持）。
Please for the love of monkeys let there be a better way.
请为猴子的爱让有更好的方法。
I've also tried....
我也试过了....
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
And this one.....
和这个.....
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
Nether have worked.
下界已经奏效了。
回答by Edmund Moshammer
Try this. Works fine for me in MS Excel 2010
尝试这个。在 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
