Excel VBA zum Abrufen des Website-Titels von der URL
Ich weiß, dass dies ziemlich alt ist, aber ich habe Schwierigkeiten damit. Ich habe einen Browserverlauf-Parser erstellt, der die Verlaufsdaten von Firefox, IE, Safari und Chrome auf den Computern unserer Benutzer (Office) durchsucht und dann Titel für Seiten abruft, die diesen Code nicht verwenden.
Ich erhalte Popups vom Internet Explorer, obwohl diese ausgeblendet sein sollten. Möchten Sie diese Seite verlassen, Popups herunterladen, dieses oder jenes ActiveX installieren, das ich schließen muss, sobald sie angezeigt werden?
Gibt es eine Möglichkeit, diese zu unterdrücken oder diese von VBA aus automatisch zu schließen? Wenn ich es nicht von Hand mache, funktioniert der Computer / Excel irgendwann nicht mehr, da ich mehrere nicht geschlossene IE-Fenster habe oder ein Fehler auftritt, weil er keine IE-Instanzen mehr öffnen kann.
Außerdem fühle ich mich ziemlich krank, weil ich weiß, dass der Internet Explorer Websites öffnet, von denen ich nichts weiß. Wir haben mehr Infektionen in diesem Büro als ich jemals zuvor hatte. Wir müssen den IE verwenden, damit die Unternehmenssoftware ausgeführt werden kann.
Gibt es einen besseren Weg, dies zu tun, oder sind wir nur Opfer des Systems? Ich bin erstaunt, wie wenig in MS Office VBA im Vergleich zu OOo BASIC tatsächlich getan werden kann. Zumindest grundlegende Funktionen (Redimensioning-Arrays, FTP-Unterstützung).
Bitte für die Liebe der Affen, lass es einen besseren Weg geben.
Ich habe es auch versucht ....
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
Und das hier.....
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 haben gearbeitet.