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