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

Step 7 ラベルかどうかチェック

URLを開くことではラベルのチェックができない為、ラベルは除くことにします。方法はURLの最後から1文字づつ#でないか確認していきます。#が見つかればラベルなので一覧には入れません。


Homeへ > Excelでアプリケーションソフト2 > リンク切れチェックソフト

シート画面

ラベルのチェック前
対策前

ラベルチェック後には、下画像のようにラベルはなくなっています。
ラベル 対策後


シートのVBAコード

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

'ラベルかどうかチェック
Private Function ExUrlLabelCheck(surl As String) As Boolean
    Dim i As Integer
    Dim nlen As Integer
    Dim s As String

    ExUrlLabelCheck = False
    nlen = Len(surl)
    For i = nlen To 0 Step -1
        s = Mid$(surl, i, 1)
        If s = "#" Then
            ExUrlLabelCheck = True
            Exit For
        ElseIf s = "." Or s = "/" Then
            Exit For
        End If
    Next
End Function


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

'リンクを取り出しセルに記入する
Private Function ExGetLinkLink(lrow As Long, lcol As Long) As Long
    Dim i As Integer
    Dim s1 As String
    Dim coun As Long
    
    coun = 0
    For i = 0 To tIElink.document.Links.Length - 1
        If Left(tIElink.document.Links(i).href, 4) = "http" Then
            If ExUrlLabelCheck(tIElink.document.Links(i).href) = False Then
                coun = coun + 1
            End If
        End If
    Next
    
    'リンク数分を行の挿入
    Range(Cells(lrow + 1, lcol), Cells(lrow + coun, lcol)).Select
    Selection.EntireRow.Insert
    
    coun = 0
    For i = 0 To tIElink.document.Links.Length - 1
        If Left(tIElink.document.Links(i).href, 4) = "http" Then
            If ExUrlLabelCheck(tIElink.document.Links(i).href) = False Then
                'セルに記入
                Cells(lrow + coun + 1, lcol) = tIElink.document.Links(i).href
                coun = coun + 1
            End If
        End If
    Next
    
    ExGetLinkLink = coun
End Function


Homeへ > Excelでアプリケーションソフト2 > リンク切れチェックソフト

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


Copyright (c) Excel-Excel ! All rights reserved