Hello,
I want to test external hyperlinks, that when they are broken color the cell yellow. I have this code but it seem to only work with an internal network
Sub TestHLinkValidity()
Dim rRng As Range
Dim fsoFSO As Object
Dim strFullPath As String
Dim strPath As String
Dim strFName As String
Dim cCell As Range
Dim response
Dim intSlashCount As Integer
Set fsoFSO = CreateObject("Scripting.FileSystemObject")
Set rRng = Selection
For Each cCell In rRng.Cells
If cCell.Hyperlinks.Count > 0 Then
strPath = GetHlinkAddr(cCell)
If fsoFSO.FileExists(strPath) = False Then
cCell.Interior.Color = 65535
End If
End If
Next cCell
End Sub
Function GetHlinkAddr(rngHlinkCell As Range)
GetHlinkAddr = rngHlinkCell.Hyperlinks(1).Address
End Function
Thanks
Jeff
Bookmarks