Excel VBA to get website Title from url

匿名 (未验证) 提交于 2019-12-03 02:42:02

问题:

HTML Page Title in Excel VBA

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.

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.

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.

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.

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).

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.

回答1:

Try this. Works fine for me in 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 


标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!