Excel: HTTP-Status Codes 200 und 404 mit Excel auslesen
Um mit Excel HTTP-Requests absetzten zu können muss zuerst das Modul “Microsoft WinHTTP Services, Version x,y” aktivieren.
Tab -> Entwicklertools -> Code anzeigen -> Verweise -> “Microsoft WinHTTP Services”

dann in den EntwicklerTools einen neuen Button anlegen und doppelklicken. Dann im ButtonCode
' Hagen Gloetter 2020
' im VBA-Editor \Extras \Verweise und dann die aktuellste "Microsoft WinHTTP Services Version" auswähle.
Private Sub CommandButton1_Click()
process_all_rows
End Sub
Sub process_all_rows()
Dim y_max As Long
Dim i, j, x, y As Long
Dim url As String
y_max = ActiveSheet.UsedRange.Rows.Count
msg = MsgBox("Be aware this will take long!" + vbCrLf + y_max + " Rows selected" + vbCrLf + "are you sure?", vbYesNo, "think")
If msg = vbNo Then
Exit Sub
End If
With ActiveSheet
y_max = .UsedRange.Rows.Count
For y = 1 To y_max
If Not IsEmpty(.Cells(y, 3).Value) = True Then ' spalte 1 = Section
url = .Cells(y, 3).Value
.Cells(y, 2).Value = GetHTTPStatus(url)
End If
Next
End With
End Sub
' Return the HTTP-Status Code as 0/1
Private Function Get_binary_HTTPStatus(url As String) As Boolean
Dim request As New WinHttpRequest
url = "https://" + url
On Error GoTo Get_binary_HTTPStatusError
request.Open "GET", url
request.send
If request.Status = 200 Then
Get_binary_HTTPStatus = True
Else
Get_binary_HTTPStatus = False
End If
Exit Function
Get_binary_HTTPStatusError:
Get_binary_HTTPStatus = False
End Function
' Return the HTTP-Status Code as Text
Private Function GetHTTPStatus(url As String) As String
GetHTTPStatus = "Error"
' Test the URL to see if it is good
Dim request As New WinHttpRequest
url = "https://" + url
On Error GoTo GetHTTPStatusError
request.Open "GET", url
request.send
If request.Status = 200 Then
GetHTTPStatus = "200 OK"
ElseIf request.Status = 301 Then
GetHTTPStatus = "Redirect GOOD"
ElseIf request.Status = 302 Then
GetHTTPStatus = "Redirect BAD"
ElseIf request.Status = 404 Then
GetHTTPStatus = "404 Page not found"
Else
GetHTTPStatus = request.Status
GetHTTPStatus = "Error"
End If
Exit Function
GetHTTPStatusError:
GetHTTPStatus = "Error"
End Function

Hinterlasse einen Kommentar
An der Diskussion beteiligen?Hinterlasse uns deinen Kommentar!