EXCEL VBA でセルにあるURL一覧からHTTPのステータスコードを取得したい

Question

前提・実現したいこと

こんにちは。
VBAを勉強していて、もう何時間も同じところで躓いており、お力をおかしいただけたらと思います。

EXCELのシートF4から下に向け２５００程のURL一覧があり、各URLを開いてHTTPのステータスコードを
取得したいと考えております。

URLを開くところまでは様々な参考書やWEBサイトを通じて何とか実現できたのですが、
そこからHTTPステータスコードをG列に記載する方法がどうしてもできず、ご教示いただけますと幸いです。

該当のソースコード

'URL表示
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

Sub Sample()
Dim iRow As Integer
Dim objIE As InternetExplorer

    For iRow = 4 To Cells(Rows.Count, "F").End(xlUp).Row
        '本サイトをIE()で起動
         Call ieView(objIE, Cells(iRow, "F").Value)
         
    　　 objIE.Quit
    Next iRow

End Sub

'①指定URLを表示するサブルーチン「ieView」
Function ieView(objIE As InternetExplorer, urlName As String, Optional viewFlg As Boolean = True)

'IE(InternetExplorer)のオブジェクトを作成する
Set objIE = CreateObject("InternetExplorer.Application")

'IE(InternetExplorer)を表示・非表示
objIE.Visible = viewFlg

'指定したURLのページを表示する
objIE.Navigate urlName

'IEが完全表示されるまで待機
Call ieCheck(objIE)

End Function

'②Webページ完全読込待機処理サブルーチン「ieCheck」
Sub ieCheck(objIE As InternetExplorer)

Dim timeOut As Date

timeOut = Now + TimeSerial(0, 0, 20)

Do While objIE.Busy = True Or objIE.readyState <> 4
DoEvents
Sleep 1
    If Now > timeOut Then
    objIE.Refresh
    timeOut = Now + TimeSerial(0, 0, 20)
End If
Loop

timeOut = Now + TimeSerial(0, 0, 20)

Do While objIE.document.readyState <> "complete"
DoEvents
Sleep 1
    If Now > timeOut Then
    objIE.Refresh
    timeOut = Now + TimeSerial(0, 0, 20)
    End If
Loop

End Sub

試したこと

以下サイトを参考にいたしましたが、うまくいかず。。
https://qiita.com/sssssumito/items/5332420d20f8ca538c8c

また「このページは表示できません」といったWEBサイトを試すとうまく動作しなかったりします。。

補足情報（EXCEL2016,Windows10,64bit ）

Answer 1

私が使っているステータスコードを取得する関数です。

Function GetWebStatus(ByVal URL As String) As String
    Dim WinHttp As Object
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

    On Error GoTo INVALID1
    WinHttp.Open "GET", URL, False
    WinHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    WinHttp.send  'GETリクエストを送信
    On Error GoTo 0 'エラー処理を元に戻す
         
    GetWebStatus = WinHttp.Status  'ステータスコードをセット
    Set WinHttp = Nothing
    Exit Function
  
INVALID1:
    Err.Clear: On Error GoTo 0 'エラー処理を元に戻す
    GetWebStatus = "Error"
    Set WinHttp = Nothing
End Function

Comments

[App-Ein]

早々にご回答いただきありがとうございます。
お蔭様でステータスコードを取得することができました！！