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

'リンクを取り出しセルに記入する
Private Function ExGetLinkLink(lrow As Long, lcol As Long) As Long
    Dim i As Integer
    Dim s1 As String
    Dim coun As Long
    Dim sno As String
    
    sno = Cells(lrow, lcol - 1)
    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
                Cells(lrow + coun + 1, lcol - 1) = "'" & sno & "-" & coun + 1
                coun = coun + 1
            End If
        End If
    Next
    
    ExGetLinkLink = coun
End Function