Excel VBA to get website Title from url
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.
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