|
「開始」ボタンの右に「停止」ボタンを追加しています。
|
|
|
| シートコード |
|
下記のコードを追加してください。
Private Sub CommandButton2_Click()
bStopFlag = True
End Sub
下記のコードに変更してください。
Private Sub CommandButton1_Click()
Dim llink As Long
Dim nowrow As Long
Dim nowcol As Long
Dim s1 As String
Dim s2 As String
Dim flag As Boolean
If TextBox1 = "" Then
MsgBox "チェックするURLを入力してください。"
TextBox1.Activate
Exit Sub
End If
s1 = ExGetExt(TextBox1.Text)
If LCase(s1) <> "html" And LCase(s1) <> "shtml" Then
MsgBox "チェックするURLは、html か shtml ファイルを指定してください。"
TextBox1.Activate
Exit Sub
End If
ExGetSrcLinkPath TextBox1.Text
If srcLinkPath = "" Then
MsgBox "チェックするURLから、/ 文字が見つかりません。URLが正しくないようです。"
TextBox1.Activate
Exit Sub
End If
CommandButton1.Enabled = False
bStopFlag = False
Cells.Clear
Range("A9") = "No."
Range("B9") = "URL"
Range("C9") = "結果"
Range("D9") = "Title"
Columns(1).HorizontalAlignment = xlHAlignLeft
'IEオープン
If ExCreateIEobject Then
nowrow = 10
nowcol = 2
'リンクを取り出しセルに記入する
llink = ExGetLink(nowrow, nowcol)
If llink > 0 Then
CommandButton2.Enabled = True
Do
flag = False
If ExDoneSearchUrl(nowrow, nowcol, s1, s2) Then
If s1 = "○" Then
Cells(nowrow, nowcol + 1) = "○"
Cells(nowrow, nowcol + 2) = s2
flag = True
End If
End If
If flag = False Then
'リンク先IEオープン
ExLinkopen nowrow, nowcol
End If
nowrow = nowrow + 1
If Cells(nowrow, nowcol) = "" Then
Exit Do
End If
If bStopFlag Then
Exit Do
End If
Loop
ExNgCheck
CommandButton2.Enabled = False
End If
End If
On Error Resume Next
tIEobj.Quit
Set tIEobj = Nothing
CommandButton1.Enabled = True
MsgBox "終了しました。"
End Sub
|
|
|
|
|
|
|
|