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.