Question

我知道这已经很老了，但我遇到了这个问题。我已经构建了一个浏览历史解析器，它在用户计算机（Office）上浏览来自Firefox，IE，Safari和Chrome的历史数据，然后获取不使用此代码的页面的标题。

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

有没有办法抑制那些或自动关闭VBA？如果我不手动执行，计算机/ Excel最终会停止工作，因为我最终得到了几个未关闭的IE窗口，或者因为无法打开IE实例而导致错误输出。

另外，我知道IE正在打开我不了解的网站，我感到非常难过。我们在这个办公室感染的次数比以前更多。我们必须使用IE来运行公司软件。

是否有更好的方法可以做到这一点，或者我们只是系统的受害者。我很惊讶与OOo BASIC相比，在MS Office VBA中实际上几乎没有什么可以做的。至少基本功能明智（redimensioning数组，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

虚空已经工作了。

Answer 1

试试这个。在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从网址获取网站标题

1 个答案: