woensdag 19 november 2014

Excel: VBA to Check Hyperlinks

I was asked to create a script to check and mark hyperlinks. The following VBA script marks the cells which contains a hyperlink with no match with the color red:

Sub HyperLinkCheck()
    Dim hypLink As Hyperlink
    Dim shtSheet As Worksheet
    Dim dirFile As String
    For Each shtSheet In Worksheets
        For Each hypLink In shtSheet.Hyperlinks
            dirFile = hypLink.Address
            If Len(Dir(dirFile)) > 0 Then
                'MsgBox "File does exist"
                Worksheets(shtSheet.Name).Range(hypLink.Range.Address).Interior.ColorIndex = xlNone 'no color
            Else
                'MsgBox "File does not exist"
                Worksheets(shtSheet.Name).Range(hypLink.Range.Address).Interior.ColorIndex = 3 'red
            End If
        Next
    Next
End Sub



Unfortunately, this script does not recognize hyperlinks created using the function HYPERLINJK. Therefore I created another script:

Sub HyperLinkTest()
    Dim dirFile As String
    Dim objCell As Range
    For Each objCell In Sheets("hyperlink").UsedRange.Columns(4).Cells
        dirFile = objCell.Value
        If Len(Dir(dirFile)) > 0 Then
            objCell.Interior.ColorIndex = xlNone  'no color
        Else
            objCell.Interior.ColorIndex = 3  'red
        End If
    Next

End Sub

This script specifically runs through the fourth column of a usedrange on sheet hyperlink.
Een reactie plaatsen