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")
    msgtxt = "Be aware this will take long!" '+ vbCrLf + String(y_max)+ " Rows selected" + vbCrLf + "are you sure?"
    msg = MsgBox(msgtxt, vbYesNo, "HG HTTP-Check")
    If msg = vbNo Then
        Exit Sub
    End If
    With ActiveSheet
        y_max = .UsedRange.Rows.Count
        For y = 2 To y_max
            If Not IsEmpty(.Cells(y, 1).Value) = True Then ' spalte 1 = Section
                url = .Cells(y, 1).Value
                 .Cells(y, 2).Value = GetHTTPStatus(url)
                 DoEvents
            End If
        Next
    End With
    msg = MsgBox("Done", vbOKOnly, "done")
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 = "URL fail"
    ' 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
    DoEvents
    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 = 403 Then
        GetHTTPStatus = "403 Forbidden"
    ElseIf request.Status = 404 Then
        GetHTTPStatus = "404 Page not found"
    ElseIf request.Status = 500 Then
        GetHTTPStatus = "500 Internal Server Error"
    ElseIf request.Status = 503 Then
        GetHTTPStatus = "503 Service Unavailable"
    Else
        GetHTTPStatus = request.Status
    End If
    Exit Function
GetHTTPStatusError:
        GetHTTPStatus = "Error HTTP-Status: " + GetHTTPStatus
End Function

Das Format ist ganz einfach:
1 Zeile komplett = Titel
1 Spalte = URL
2 Spalte = Ergebnis