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

Step 11 リンク切れ先を再チェック

リンクチェックを行った結果、接続できなかったURLを再度チェックします。10行目から順に下へ「×」を探し見つかれば、再度オープンしてみます。ラベルの場合は、最初と同じようにアンカーの有無を探します。



Homeへ > Excelでアプリケーションソフト2 > リンク切れチェックソフト

シート画面

リンクが正常な場合「○」が、リンク切れの場合「×」が表示されています。
リンクチェック済みの画面

シートのVBAコード

下記のVBAコードを追加してください。

'リンク先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

Homeへ > Excelでアプリケーションソフト2 > リンク切れチェックソフト

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved