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

Private Sub CommandButton2_Click()
    bStopFlag = True
End Sub


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

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