HTTP请求（GET）

Sub CheckFileExists()

Dim dT As Double: dT = Timer

    Const WORKSHEET_NAME As String = "FileExists"
    Const SOURCE_FIRST_CELL_ADDRESS As String = "B50"
    Const DESTINATION_COLUMN_STRING As String = "C"
    Const YES_STRING As String = "EXISTS"
    Const NO_STRING As String = "CHECK"
    Const PRINT_MESSAGE As Boolean = False
    Const PRINT_MESSAGE_IF_OK As Boolean = False
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim ws As Worksheet: Set ws = wb.Worksheets(WORKSHEET_NAME)
    If ws.AutoFilterMode Then ws.AutoFilterMode = False 

    Dim srg As Range: Set srg = SetColumn(ws.Range(SOURCE_FIRST_CELL_ADDRESS))
    If srg Is Nothing Then Exit Sub

    Dim Data() As Variant: Data = GetColumn(srg)

    Dim r As Long
    Dim URL As String
    Dim UrlExists As Boolean

    For r = 1 To UBound(Data, 1)
        URL = CStr(Data(r, 1))
        If Len(URL) > 0 Then
            If IsUrlGood(URL, PRINT_MESSAGE, PRINT_MESSAGE_IF_OK) Then
                UrlExists = True
            End If
        End If
        Data(r, 1) = IIf(UrlExists, YES_STRING, NO_STRING)
        UrlExists = False
    Next r

    Dim drg As Range: Set drg = srg.EntireRow.Columns(DESTINATION_COLUMN_STRING)
    drg.Value = Data

Debug.Print "Time Passed: " & Format(Timer - dT, "0.000")

End Sub

Function IsUrlGood( _
    ByVal URL As String, _
    Optional ByVal PrintMessage As Boolean = False, _
    Optional ByVal PrintMessageIfOK As Boolean = False) _
As Boolean
    On Error GoTo ClearError
    
    Dim StatusNumber As Long
    
    With CreateObject("MSXML2.XMLHTTP.6.0") ' New MSXML2.XMLHTTP60 '
        .Open "HEAD", URL, False
        .send
        StatusNumber = .Status
    End With
    
    If StatusNumber = 200 Then
        IsUrlGood = True
        If PrintMessageIfOK Then Debug.Print URL, StatusNumber, "OK"
    Else
        If PrintMessage Then Debug.Print URL, StatusNumber
    End If

ProcExit:
    Exit Function
ClearError:
    If PrintMessage Then
        Dim ED As String: ED = Err.Description: ED = Left(ED, Len(ED) - 2)
        Debug.Print URL, ED ' remove trailing 'vbCrLf' ('- 2')
    End If
    Resume ProcExit
End Function

Function SetColumn(ByVal FirstCellRange As Range) As Range
    With FirstCellRange
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set SetColumn = .Resize(lCell.Row - .Row + 1)
    End With
End Function

Function GetColumn(ByVal OneColumnRange As Range) As Variant()
    With OneColumnRange
        If .Rows.Count = 1 Then ' one cell
            Dim Data As Variant: ReDim Data(1 To 1, 1 To 1)
            Data(1, 1) = .Value: GetColumn = Data
        Else ' multiple cells
            GetColumn = .Value
        End If
    End With
End Function