Titel von URLs auslesen
01.04.2016 14:02:33
URLs
mit dem folgenden Code überprüfe ich eine Liste von Links nach deren erreichbarkeit.
Das funktioniert soweit zu meiner Zufriedenheit.
gibt es eine möglichkeit darüber hinaus auch noch eine Information zum Link, nämlich den Titel der Webseite, auszulesen.
Gerne auch extra, aber auf keinen Fall über den IE. Ich bevorzuge da FireFox.
Vieleln lieben Dank.
Selena
Sub rr_CheckURL()
'Hyperlinks auf Erreichbarkeit prüfen
Dim rngBer As Range, rngC As Range, oHttpReq As Object
Dim strUrl As String, lngS As Long, strErg As String
Set oHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
Set rngBer = Sheets("Links").Range("C12:C200") 'Cells(12, 3).Resize(Sheets("Links").Cells( _
Rows.Count, 3).End(xlUp).Row - 1)
rngBer.Interior.Pattern = xlNone
On Error Resume Next
For Each rngC In rngBer
strUrl = rngC.Text
' falls nötig, vorn "h ttp://" ergänzen
If LCase$(Left$(strUrl, 7)) "http://" Then strUrl = "http://" & strUrl
lngS = 0
With oHttpReq
.Open "GET", strUrl
.Send
lngS = .Status
Select Case lngS
Case 200: strErg = .StatusText
Case 404: strErg = .StatusText
rngC.Font.Color = 255
Case Else: strErg = "Fehler"
rngC.Font.Color = 255
End Select
rngC.Offset(0, 5) = lngS ' zum Testen
'rngC.Offset(0, 2) = strErg ' zum Testen
'rngC.Offset(0, 3) = strUrl ' zum Testen
End With
Next rngC
On Error GoTo 0
Set oHttpReq = Nothing
End Sub