Excelでリンク切れチェックソフトを作ってみよう
Step 4 リンク先のリンクをチェックする
リンク一覧のURLをさらにチェックしていきます。方法はスタート時のチェックと同じです。指定時間内に読むことができなければリンク切れになります。そのチェック方法も同様に、ReadyState = 4 で行っています。
Homeへ >
Excelでアプリケーションソフト2 >
リンク切れチェックソフト
シート画面
リンク先のチェック中には、「リンク先をオープンしています。」+秒数 が表示されています。
シートのVBAコード
下記のコードを入力してください。
'リンク先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
下記のVBAコードに変更してください。
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へ >
Excelでアプリケーションソフト2 >
リンク切れチェックソフト
■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します
Copyright (c) Excel-Excel ! All rights reserved