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

'拡張子を取得
Private Function ExGetExt(sfina As String) As String
    Dim i As Long
    Dim s1 As String
    
    ExGetExt = ""
    'ファイル名の最後の文字から「.」を探す
    For i = Len(sfina) To 1 Step -1
        If Mid(sfina, i, 1) = "." Then
            '拡張子を取得
            ExGetExt = Mid(sfina, i + 1)
            Exit For
        End If
    Next
End Function

'チェックするURLのパスを取得
Private Sub ExGetSrcLinkPath(sfina As String)
    Dim i As Integer
    Dim nlen As Integer
    Dim s As String

    srcLinkPath = ""
    nlen = Len(sfina)
    For i = nlen To 0 Step -1
        s = Mid$(sfina, i, 1)
        If s = "/" Then
            srcLinkPath = Left$(sfina, i)
            Exit For
        End If
    Next
End Sub

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

Private Sub CommandButton1_Click()
    Dim llink As Long
    Dim nowrow As Long
    Dim nowcol As Long
    Dim s1 As String
    
    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
    
    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