Excel VBA para obter o título do site a partir do URL

Título da página HTML no Excel VBA

Eu sei que isso é bastante antigo, mas estou tendo dificuldades com isso. Eu construí um analisador de histórico do navegador que percorre os dados do histórico do Firefox, IE, Safari e Chrome em nossos computadores de usuários (Office) e, em seguida, obtém títulos para páginas que não usam esse código.

Eu recebo pop-ups do IE, embora deva ficar oculto. Você quer sair desta página, fazer o download de pop-ups, instalar este ActiveX, isso ou aquilo que eu tenho que fechar à medida que eles surgem.

Existe uma maneira de suprimir esses ou fechar automaticamente os do VBA? Se eu não fizer isso manualmente, o computador / Excel eventualmente pára de funcionar, pois acabo com várias janelas não fechadas do IE ou erros porque não é possível abrir mais instâncias do IE.

Além disso, eu me sinto muito mal sabendo que o IE está abrindo sites sobre os quais eu não sei nada. Nós temos mais infecções neste escritório do que eu já tive que lidar antes. Temos que usar o IE para que o software da empresa seja executado.

Existe uma maneira melhor de fazer isso ou somos apenas vítimas do sistema? Eu estou apenas impressionado com o quão pouco pode realmente ser feito no MS Office VBA em comparação com o OOo BASIC. Pelo menos, recurso básico sábio (matrizes de redimensionamento, suporte a FTP).

Por favor, pelo amor dos macacos, que haja um caminho melhor.

Eu também tentei ....

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

E este.....

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

questionAnswers(1)

yourAnswerToTheQuestion