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

Step 4 リンク先のリンクをチェックする

リンク一覧のURLをさらにチェックしていきます。方法はスタート時のチェックと同じです。指定時間内に読むことができなければリンク切れになります。そのチェック方法も同様に、ReadyState = 4 で行っています。

Homeへ > アプリケーションソフト > リンク切れチェックソフト > Step4 リンク先のリンクをチェックする

スポンサードリンク



シート画面

リンク先のチェック中には、「リンク先をオープンしています。」+秒数 が表示されています。
サイト内のリンク先チェック

スポンサードリンク



シートコード

下記のコードを入力してください。

'リンク先IEオープン
Private Function ExLinkopen(lrow As Long, lcol As Long) As Boolean
    Dim sttime As Long
    Dim passtime As Long
    Dim tIElink As Object
    
    ExLinkopen = False
On Error GoTo ErrExit
    Set tIElink = CreateObject("InternetExplorer.application")
    tIElink.navigate 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
            ExLinkopen = True
        End If
    End If
ErrResume:
On Error Resume Next
    tIElink.Quit
    Set tIElink = Nothing
    Label2.Visible = False
    Exit Function
ErrExit:
    Resume ErrResume
End Function


下記のコードに変更してください。

Private Sub CommandButton1_Click()
    Dim llink As Long
    Dim nowrow As Long
    Dim nowcol As Long
    
    If TextBox1 = "" Then
        MsgBox "チェックするURLを入力してください。"
        TextBox1.Activate
        Exit Sub
    End If
    
    Cells.Clear
    'IEオープン
    If ExCreateIEobject Then
        nowrow = 10
        nowcol = 2
        'リンクを取り出しセルに記入する
        llink = ExGetLink(nowrow, nowcol)
        If llink > 0 Then
            'リンク先IEオープン
            ExLinkopen nowrow, nowcol
        End If
    End If
    
On Error Resume Next
    tIEobj.Quit
    Set tIEobj = Nothing
End Sub

スポンサードリンク





Homeへ > アプリケーションソフト > リンク切れチェックソフト > Step4 リンク先のリンクをチェックする

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


関連コンテンツ

Copyright (c) Excel-Excel ! All rights reserved