|
リンク先のチェック中には、「リンク先をオープンしています。」＋秒数 が表示されています。
|
|
|
| シートコード |
|
下記のコードを入力してください。
'リンク先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
|
|
|
|
|
|
|
|