Excelでリンク切れチェックソフトを作ってみよう

'リンク先IEオープン
Private Function ExNgIeOpen(lrow As Long, lcol As Long) As Boolean
    Dim sttime As Long
    Dim passtime As Long
    Dim s1 As String
    Dim s2 As String
    
    ExNgIeOpen = False
On Error GoTo ErrExit
    Set tIElink = CreateObject("InternetExplorer.application")
    tIElink.navigate Cells(lrow, lcol)
Debug.Print Cells(lrow, lcol)
    '読み込みが終わるまで30秒待つ
    Label2.Visible = True
    sttime = Timer
    Do
        '経過時間を算出
        passtime = Timer - sttime
        Label2.Caption = "リンク先をオープンしています。 (" & passtime & ")"
        DoEvents
        If passtime >= 30 Then
            Exit Do
        End If
        '読込み完了
        If tIElink.ReadyState = 4 Then
            Exit Do
        End If
    Loop
    If tIElink.ReadyState = 4 Then
        If LCase(tIElink.document.URL) = LCase(Cells(lrow, lcol)) Then
            Cells(lrow, lcol + 1) = "○"
            Cells(lrow, lcol + 2) = tIElink.document.Title

            If srcLinkPath = Left(LCase(Cells(lrow, lcol)), Len(srcLinkPath)) Then
                'If ExDoneSearchUrl(lrow, lcol, s1, s2) = False Then
                    If ExUrlLabelCheck(Cells(lrow, lcol), s1) = True Then
                        If ExSearchLabel(s1, LCase(tIElink.document.body.innerHTML)) = False Then
                            Cells(lrow, lcol + 1) = "×"
                        End If
                    End If
                'End If
            End If
            ExNgIeOpen = True
        End If
    End If
    If ExNgIeOpen = False Then
        Cells(lrow, lcol + 1) = "×"
    End If
ErrResume:
On Error Resume Next
    tIElink.Quit
    Set tIElink = Nothing
    Label2.Visible = False
    Exit Function
ErrExit:
    Resume ErrResume
End Function

'リンク切れの場合、再チェックを行う
Private Sub ExNgCheck()
    Dim lrow As Long
    Dim i As Long
    
    lrow = Range("A65536").End(xlUp).Row
    For i = 10 To lrow
        If Cells(i, 3) = "×" Then
            Call ExNgIeOpen(i, 2)
        End If
    Next
End Sub