Page 1 of 2 1 2 LastLast
Results 1 to 10 of 15

Thread: Link Checks

  1. #1

    Link Checks



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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?
    Attached Files Attached Files
    Last edited by GaryA; 2012-04-06 at 11:15 PM.

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,225
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    Can you give some more details on when it fails?
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training) or with my book M is for Data Monkey!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  3. #3
    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"
    --------------------------------

  4. #4
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,225
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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.
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training) or with my book M is for Data Monkey!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  5. #5
    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 by GaryA; 2012-04-18 at 04:31 PM.

  6. #6
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,225
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training) or with my book M is for Data Monkey!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  7. #7
    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/Do...umber=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 by GaryA; 2012-04-20 at 04:55 PM.

  8. #8
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,225
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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...
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training) or with my book M is for Data Monkey!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  9. #9
    Hi Ken, the link points to a Document Server that really does exist on our intranet. The path is http://web2.acd.com/ProcessPortal/Do...umber=PM-G-002. But the document (identified by the documentNumber PM-G-002) does not exist. When the code encounters this link, the code indicates that the link is valid when in reality it is not.
    Last edited by GaryA; 2012-04-20 at 11:58 PM.

  10. #10
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,225
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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.
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training) or with my book M is for Data Monkey!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

Page 1 of 2 1 2 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •