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

Step 6 チェックするURLのチェック

順番が逆になりましたが、チェックするURLが正しいかチェックし、正しい場合そこからパス名を取り出します。始めに拡張子を取り出し、HTMLファイルかSHTMLファイルか確認します。そうでなければエラーメッセージを表示し処理を中止します。次にパス名を取得します。URLの最後の文字から一文字づつ取り出し「/」を探しみつかればそこより前がパス名になります。見つからなければエラー表示をし、処理を中止します。

Homeへ > アプリケーションソフト > リンク切れチェックソフト > Step6 チェックするURLのチェック

スポンサーリンク






シート画面

ファイルを指定しなかった場合、「チェックするURLは、html か shtml ファイルを指定してください。」とメッセージが表示されています。

スポンサーリンク



シートコード

下記のコードを入力してください。

'拡張子を取得
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

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

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

スポンサーリンク






Homeへ > アプリケーションソフト > リンク切れチェックソフト > Step6 チェックするURLのチェック

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved