Link Checks

G

GaryA

New member
Joined
Apr 6, 2012
Messages
51
Reaction score
0
Points
0
Trying to check cells that contains paths to a File, a Folder, URL, or a Sharepoint Site by changing the font color of the active cell to validate the hyperlink. This works pretty good most of the time, but not everytime. Any suggestions?
 

Attachments

  • check-links.zip
    982.3 KB · Views: 73
Last edited:
It fails on ExistPath, it is sometime true when it is actually false or visa versa.

-------------------------------------
If Len(Dir(Fname)) > 0 Then ' verify path
ExistPath = True
Else

If Len(Dir(Fname, vbDirectory)) > 0 Then ' verify the file
ExistPath = True
End If
End If

End If

If ExistPath Then
ActiveCell.Font.Color = RGB(0, 0, 255) ' Turn font blue if valid
'Debug.Print "Valid"
Else
ActiveCell.Font.Color = RGB(255, 0, 0) ' Turn font red if not valid
'Debug.Print "Not Valid"
--------------------------------
 
Hi Gary,

This isn't going to fix your problem at all, but since I run on 64bit Office, I had to modify your API call to work. Figured I might as well share the modifications to help future proof this when you've got it totally sorted. I replaced your API code with this:

Code: 
#If Win64 Then
    Private Declare PtrSafe Function InternetCheckConnection Lib "wininet.dll" _
        Alias "InternetCheckConnectionA" ( _
            ByVal lpszUrl As String, _
            ByVal dwFlags As LongPtr, _
            ByVal dwReserved As LongPtr) As LongPtr
#Else
    Private Declare Function InternetCheckConnection Lib "wininet.dll" _
        Alias "InternetCheckConnectionA" ( _
            ByVal lpszUrl As String, _
            ByVal dwFlags As Long, _
            ByVal dwReserved As Long) As Long
#End If

So that will now work in both 32bit and 64bit versions of Office.

Now, as to the real issue... I tested your code, and it seems to work fine for me here, but I'm not sure if I'm doing anything "weird" enough to trigger the issue. To debug this, we need to know the symptons of the actual issues, i.e. where it fails. The one thing we know for sure is that it never works one way or another, it always works the way we programmed it. We just don't always realize that things have some idiosyncracies that we didn't cater for. (My forum sig for years was always "I hate it when my computer does what I tell it to and not what I want it to"!)

Can you share with me a list of scenarios where it does not work? What I'm looking for is:
- The exact text that is in the Excel cell
- The exact hyperlink that is embedded in the Excel text (it may be different than what's showing)
- The full file path to the file or folder that you're targeting
- An indication of what it did return and what you feel is should have returned. (False positive, or false negative?)

With that info I can set up a test on my side to mirroir your paths and debug any issues that I find. :)
 
Exact Text: \\VSS\Data\Repository. The issues here is that I do not have network permissions to the folder. The macro hangs when it encounters this cell. I need to account for lack of permissions, say, in a different color and ID the issue and then move on.

Exact hyperlink: The way it should work is:
1) delete the existing hyperlink in the active cell
2) takes the text in the active cell and create a new hyperlink
3) Test the hyperlink, If valid: Blue, if invalid: Red

I was also trying to take into account spaces in the paths to files and folders.

In my actual code, all mapped drives are converted to UNC paths, before testing the link. i.e. P:\ is mapped to \\VSS

For Web links, I am not sure if %20 replacements of spaces cause any issues.
 
Last edited:
Hi Gary,

I've made a minor mod to try and deal with the permissions error. I notice on my system that it throws Error 52 each time I try to connect to a drive with no access. Give this a go:

Code: 
Private Sub FixSingleCellHyperlink()
    Application.ScreenUpdating = False ' Turn off Screen updating
    
    Dim Fname As String
    Dim bNoRights As Boolean
    Sheets("Artifacts").Select ' Select Artifact Worksheet
    Cells(Application.ActiveCell.Row, 1).Select 'Go to 1st cell of current row
    ActiveCell.Offset(0, 9).Select ' Select the Artifact Column
    Set rngArea = Range("Direct_Artifact_Link_Group") 'Set the Defined range
    
    Fname = Selection.Value ' Select active cell
    If Fname = "" Then ' Check if cell is empty, if so, warn user.
        MsgBox "Sorry, There is no data in the cell.", vbOKOnly
        Exit Sub
    End If
    
  
    ActiveCell.Value = ConvertDrive2ServerName(Fname) ' Convert Path to UNC, if mapped, and copy selected path to the Active cell.
    Fname = Selection.Value ' Get the Active Cell Text
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Fname, TextToDisplay:=Fname ' Create Hyperlink from active cell text
    '***********************************************************************
    ' Hyperlink Validation - Check single
    '***********************************************************************
    ExistPath = False
    If Left(Fname, 7) = "http://" Or Left(Fname, 8) = "https://" Or Left(Fname, 6) = "ftp://" Or Left(Fname, 7) = "ftps://" Then
        ExistPath = InternetCheckConnection(Fname, 1, 0) '1=FLAG_ICC_FORCE_CONNECTION
    Else
         'Fname = " "" " + Fname + " "" "
        On Error Resume Next
        Err.Clear
        If Len(Dir(Fname)) > 0 Then ' verify path
                If Err.Number = 52 Then
                    'Error thrown due to lack of directory access
                    bNoRights = True
                Else
                    ExistPath = True
                End If
        Else
       
           If Len(Dir(Fname, vbDirectory)) > 0 Then ' verify the file
                If Err.Number = 52 Then
                    'Error thrown due to lack of directory access
                    bNoRights = True
                Else
                    ExistPath = True
                End If
        End If
        
    End If
        
    If ExistPath Then
        ActiveCell.Font.Color = RGB(0, 0, 255) ' Turn font blue if valid
                'Debug.Print "Valid"
    Else
        If bNoRights Then
            ActiveCell.Font.Color = RGB(0, 255, 0)
        Else
            ActiveCell.Font.Color = RGB(255, 0, 0) ' Turn font red if not valid
                    'Debug.Print "Not Valid"
        End If
    'test = ConvertDrive2ServerName(Fname)
    
    End If
    
    Set rngArea = Nothing ' clear range value
    
    Application.ScreenUpdating = True ' Turn on Screen updating
    
      
Err_Trap:
    If Err <> 0 Then
        Err.Clear
        Resume Next
    End If
    
End Sub
 
Thanks Ken, I added another "End If" at the end, but your code works perfectly. It flags the cells with color green when it connot access that location. I made the same mod to the "Check_For_Broken_Hyperlinks" routine (Checks all links in column instead of a single link) and it works most excellent. Many thanks!

I came accross another scenario in the following intranet link: http://web2.acd.com/ProcessPortal/DocumentProxy.ashx?DocumentNumber=PM-G-002. To the code, this link is valid because it looks at the first part of the link only and not the whole string, when in reality, the document does not exits. Any thoughts?
 
Last edited:
Hi Gary,

On mine that link fails, presumably because I don't have access to the intranet... It should be passing the entire link through as well as you don't manipulate Fname in any way, just test for it's preface...
 
Ahhh... I see what you mean. It actually works the same as a website... if the page is not found, it re-routes to an index page, correct?

Interestingly enough, I was able to test this using my site. If I put in the URL to this page it believes it's there (as it should). If I add a letter to the URL at the end, it still believes it's there, even though it actually triggers a 404 error... which re-routes you to my homepage.

I'll work on this a little later and see if I can come up with a solution. :)
 
Actually, I was wrong...

When you try to hit an invalid forum URL here, it does NOT 404 or redirect. The CMS actually returns content inside the URL of the invalid page. As an example, this page is invalid: http://www.excelguru.ca/forums/showthread.php?821212121212129-Link-Checks

Notice though that the header does show the URL I specified. This means that the URL IS valid according to the server. The only method I can think of is to parse all the text in the content of the returned page looking for an element that is common only to the "does not exist" page.

Does that make sense?
 
Hi Ken,

Wheny ou say "parse all thetext in the cntent of th returned page" are we talking about the URL portion or actual content?. You Would think that there would be a response code identifying the issue that we could key in on (i.e 404, 301, 200), instead? Would a reference to msinet.ocx, an ActiveX Control belonging to Microsoft Internet Transfer Control help with this?
 
Hi Gary,

I'm talking actual content. :(

The challenge is that these Content Managment Systems are now getting smart enough that the don't seem to return a 404 or 301 error. They just serve up their own message about the page being invalid.

I've never used msinet.ocx, so I can't say if that would help or not. I can try and take a look, but I've got some other stuff I have to do tonight...
 
Ken Puls said:
When you try to hit an invalid forum URL here, it does NOT 404 or redirect. The CMS actually returns content inside the URL of the invalid page. As an example, this page is invalid: http://www.excelguru.ca/forums/showthread.php?821212121212129-Link-Checks

Notice though that the header does show the URL I specified. This means that the URL IS valid according to the server. The only method I can think of is to parse all the text in the content of the returned page looking for an element that is common only to the "does not exist" page.
Click to expand...

I noticed that your page offers up the following text "No Thread specified. If you followed a valid link, please notify the administrator". Is this something that is unique to your site only?
 
It's something that is served up by the vBulletin Content Management System that I use to host my site. So if your site served up some common phrase instead of a 404 error, that could potentially be picked up on. You'd want to make sure that it is a textual phrase (or something) that isn't going to be served up by anything else though.
 
You must log in or register to reply here.
Back
Top