複数URLから404エラーのページを探す方法

きっかけは楽天市場の商品画像から404エラーの画像を探そうとしたことです。
方法はCHATGPTが教えてくれました^^

用意するもの Excelワークブックの
A列に該当URLを貼り付けてハイパーリンク化

下記VBAをコードを入れて実行する

Sub CheckHyperlink()

Dim lastRow As Long
Dim hl As Hyperlink
Dim result As String

lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For Each hl In ActiveSheet.Range("A1:A" & lastRow).Hyperlinks
    result = ""
    If hl.Range.Hyperlinks(1).Address <> "" Then
        If InStr(hl.Range.Hyperlinks(1).Address, "http") > 0 Then
            If Not URLExists(hl.Range.Hyperlinks(1).Address) Then
                result = "404エラー"
            End If
        End If
    End If
    hl.Range.Offset(0, 1).Value = result
Next hl

End Sub

Function URLExists(url As String) As Boolean

On Error Resume Next
With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "HEAD", url, False
    .Send
    URLExists = .Status = 200
End With
On Error GoTo 0

End Function

Sub AddHyperlinksToSelectedCells()
Dim cell As Range
For Each cell In Selection.Cells
ActiveSheet.Hyperlinks.Add Anchor:=cell, Address:=cell.Value
Next cell
End Sub

いいなと思ったら応援しよう!