Pre - checking Valid Sheet Names in Hyperlink

[High Plains Grifter]

Hello, people.

I have the following macro, which is assigned to ctrl+shift+h to allow users to make a list and to insert hyperlinks to other sheets that have more details than the list can show:

Sub linker()
Dim strDocument As String
Dim strSheet As String
Dim strAddress As String
Dim strLink As String

'assume control of the status bar and make sure we have a clean slate
    Application.DisplayStatusBar = True
    Application.StatusBar = ""
'The department, which is used to decide which document to link to, is in coloumn C
    strLink = ActiveSheet.Range("C" & ActiveCell.Row).Value

'If the user has not selected a workflow to base the link upon, give them a snotty message
If ActiveCell.Column <> 12 Then
        Application.StatusBar = "Automatic link function is only valid for workflows - please select a valid workflow name"
Else
        'Carry on
End If

'If the department is assistance, we want to go to the assistance control sheet
If strLink = "Assistance" Then
        strDocument = "List 08.1 Assistance Workflows and Tasks.xlsm"
'If the department is claims, go there
ElseIf strLink = "Claims" Then
        strDocument = "List 08.2 Claims Workflows and Tasks.xlsm"
'if the department is neither claims nor assistance then hit the user about the head
Else
        MsgBox "If you wish to add a hyperlink, you need to list whether the workflow is Claims or Assistance", vbOKOnly, "Cannot Find Link Document"
        Exit Sub
End If

    'The target documents are all in the lists folder, so stick that in
    strAddress = "\\Cg4\shared\Projects\GoTrex\Lists\"
    'The name of the workflow (in the highlighted cell) should also be the name of a sheet in the target document,
    'if the workflow has been properly documented, so get that
    strSheet = ActiveCell.Value
    'if the user is an idiot, kick them out
If strSheet = "" Then GoTo errs
    
    ActiveCell.Select
'If it still effs up then I guess we should apologise or something
On Error GoTo errs
    'Stick a hyperlink in the cell by joining up the address, document and sheet name we have taken.
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
        Address:=strAddress & strDocument, _
        SubAddress:="'" & strSheet & "'!A1", TextToDisplay:=strSheet
    'Move down one cell, so the user can clearly see that everything has gone according to plan
    ActiveCell.Offset(1, 0).Activate
    'relinquish control of the status bar
    Application.DisplayStatusBar = False
    Exit Sub

errs:
Application.StatusBar = "No page has been found in '" & strDocument & "' to match the workflow title you have listed."
End Sub

I was surprised to see that even if the contents of the active cell is not a valid sheet name in the target document, the link is still inserted without error. If the link is subsequently clicked, the target document will open and an "invalid reference" error box will appear.

Is there any way to check whether the contents of the cell constitutes a valid sheet name in the target workbook at the point at which the hyperlink is created, without opening up the target document?

Thanks for your time!

 

[Jerry Sullivan]

Hi Mark,

You can use Dir() to test if a file exists....

    Dim strFileSpec As String
    strFileSpec = strAddress & strDocument
    If Dir(sFileSpec) <> "" Then
        MsgBox sFileSpec & " exists"
    Else
        MsgBox sFileSpec & " doesn't exist"
    End If

Enjoyed your commenting...

    'The name of the workflow (in the highlighted cell) should also be the name of a sheet in the target document,
    'if the workflow has been properly documented, so get that
    strSheet = ActiveCell.Value
    'if the user is an idiot, kick them out
If strSheet = "" Then GoTo errs
    
    ActiveCell.Select
'If it still effs up then I guess we should apologise or something
[/QUOTE]

:rofl:

 

[High Plains Grifter]

Hi Jerry, cheers for your reply!

I was hoping to find a way to check whether the named sheet exists within the target document.

When you insert an hyperlink into a document manually, you are given a dialogue box which allows you to select a location from available valid sheets in the target document; in other words, you are only able to select existing sheets to target. I would like to acheive the same thing in my procedure. In pseudo code it might look something like this:

strTargetSheet = activecell.value

IF TargetWorkbook.sheets(strTargetSheet) exists then
    add hyperlink to TargetWorkbook.sheets(strTargetSheet).Range("A1")
ELSE
    'tell the user that the cell value is an invalid location in the target workbook
END IF

It is the "if... exists" bit that is causing me trouble... how can I populate a list like in the dialog that is seen when entering the hyperlink manually?

Thamnks again!

 

[Jerry Sullivan]

Mark,

Ahaa... I had missed the part about checking if the Sheet exists in you OP.

You should be able to use the function below to test if a Sheet in an External Workbook exists.

You might need to add a reference to the Library: Microsoft ADO Ext. 2.x for DDL and Security
to your VBA Project.

Public Function SheetExists(sFileSpec As String, _
        sSheetName As String) As Boolean
'---Returns True if Sheet found, False if not found
'---Syntax: SheetExists("C:\TEST\MyFile.xlsx","MySheet")
    
    Dim cn As Object, cat As Object, tbl As Object
    Dim sTemp As String, bFound As Boolean
    If Dir(sFileSpec) = "" Then
        SheetExists = False
        Exit Function
    End If
    
    Set cn = CreateObject("ADODB.Connection")
    Set cat = CreateObject("ADOX.Catalog")
    Set tbl = CreateObject("ADOX.Table")
    cn.Open "dsn=excel files;dbq=" & sFileSpec
    cat.ActiveConnection = cn
 
    For Each tbl In cat.Tables
        sTemp = Replace(tbl.Name, "'", "")
        If sSheetName & "$" = sTemp Then
           bFound = True
           Exit For
        End If
    Next
    cn.Close
    Set cn = Nothing
    Set cat = Nothing
    Set tbl = Nothing
    SheetExists = bFound
End Function

Here's an example of how you might incorporate into your Linker Sub.

strAddress = "\\Cg4\shared\Projects\GoTrex\Lists\"
strFileSpec = strAddress & strDocument
strSheet = ActiveCell.Value

If SheetExists(strFileSpec, strSheet) Then
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
        Address:=strFileSpec, _
        SubAddress:="'" & strSheet & "'!A1", TextToDisplay:=strSheet
    ActiveCell.Offset(1, 0).Activate
Else
    MsgBox "Cell value is an invalid location in the target workbook"
End If

 

[High Plains Grifter]

Apologies for delay in reply Jerry - someone panics at work and suddenly all the priorities change, only to all settle down again after a short time...

Your solution is brilliant and works perfectly. Thanks for this. I don't understand exactly what the CreateObject lines are creating and how you know what all these ADOX and ADODB things are but I can kind of see the sense of what you are doing!

Thanks!