Excel VBA从网址获取网站标题 [英] Excel VBA to get website Title from url

问题描述

Excel VBA中的HTML页面标题

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

我从IE中获取弹出窗口，即使它被隐藏。你想离开这个页面，下载弹出窗口，安装这个ActiveX这个或那个我必须关闭的，因为他们出现。

有没有办法压制那些还是自动关闭VBA？如果我不这样做，电脑/ Excel最终会停止工作，因为我结束了几个未封闭的IE窗口或者错误，因为它不能打开任何IE实例。

加上我觉得很生病，知道IE正在打开我不知道的网站。我们在这个办公室里感染比我以前不得不处理的更多。我们必须使用IE来运行公司软件。

有没有更好的方式来做这个或者我们只是系统的受害者。我只是觉得，与OOo BASIC相比，MS Office VBA实际上几乎没有什么可以实现的。至少基本功能（重新定位阵列，FTP支持）。

请为猴子的爱让更好的方式。

我也试过....

 函数fgetMetaTitle（ByVal strURL）As String 
 
 Dim stPnt As Long，x As String 
 Dim oXH As Object 
'获取URL的HTML源
设置oXH = CreateObject（msxml2.xmlhttp）
 With oXH 
。打开get，strURL，False 
 .send 
x = .responseText 
结束
设置oXH = Nothing 
'解析HTML源代码标题
如果InStr（1，UCase（x），< TITLE>）然后
 stPnt = InStr（1，UCase（x），< TITLE>）+ Len（< ; TITLE>）
 fgetMetaTitle = Mid（x，stPnt，InStr（stPnt，UCase（x），< / TITLE>） -  stPnt）
 Else 
 fgetMetaTitle = 
结束如果
 
结束功能
  

这一个.. ...

 函数getMetaDescription（ByVal strURL As String）As String 
 
'需要早期绑定引用MSHTML对象库
 Dim html1作为HTMLDocument 
 Dim html2作为HTMLDocument 
 
设置html1 =新的HTMLDocument 
设置html2 = html1。 createDocumentFromUrl（strURL，）
 
 Do Until html2.readyState =complete：DoEvents：Loop 
 
 getMetaDescription = html2.getElementsByTagName（meta）。Item描述）内容
 
设置html2 =没有
设置html1 =没有
 
结束函数
  

Nether已经工作。

解决方案

尝试这个。在MS Excel 2010中为我工作正常

  Dim title As String 
 Dim objHttp As Object 
 Set objHttp = CreateObject（MSXML2.ServerXMLHTTP）
 objHttp.OpenGET，http://www.google.com/，False 
 objHttp.Send
 
 title = objHttp.ResponseText 
 
如果InStr（1，UCase（title），< TITLE>）然后
 title = Mid（title，InStr（1，UCase（title） ，< TITLE>））+ Len（< TITLE>））
 title = Mid（title，1，InStr（1，UCase（title），< / TITLE> ）
 Else 
 title =
结束如果
 
 MsgBox标题
  

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.

解决方案

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

这篇关于Excel VBA从网址获取网站标题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！