Hyperlinking and VBA help

[Igawa29]

Thank you again for fielding my questions Tek Tips. Anyway here are my two delmas:

1) I need to change the display name of my hyperlinks in my tables. Instead of showing the full path I would like simple names, is there vba script to do this massive if then? I was reseraching and found the .TextToDisplay code, not sure how to set it up.

2) I am trying to create hyperlinks in my access table to open other access tables. This data is being updated monthy and I know how to do this manually by creating a hyperlink and then selecting the table I want to open.. however with 3,000 tables to look at is there a way to use VBA to create these links rather than setting them up manually.

 

[N1GHTEYES]

I'm not familiar with Access, but here is the code I use to create hyperlinks in Excel. Perhaps it has something useful for you?

Basically this lets the user select a range of cells containing path and file specs. It then creates hyperlinks in these cells. Whether the displayed text is the full path and filename or just the filename alone is a user-choice.

Sub AL_HyperLinks_Create()
'**********************************************************************
'  1. FUNCTIONAL DESCRIPTION of AL_HyperLink_Create
'
'     Creates hyperlinks in a selected range.
'     Each cell in the range must contain the full file and apth spec to a valid file.
'
'  2. REFERENCES - None
'
'  3. INPUTS - None
'
'  4. OUTPUTS - None
'
'  5. EXTERNAL EFFECTS
'     Creates hyperlinks in the selected cells if those cells hold valid filespecs.
'
'**********************************************************************
Dim screenmessage As String, pathmsg As String, text2disp As String, celltext As String
Dim ext As String, nameonly  As String, Path As String
Dim CreateHL As Integer, DispPath As Integer, numerrs As Integer, usrrows As Integer
Dim usrrange As Range, thiscell As Range
Dim badname As Boolean

On Error Resume Next

'give the user instructions and confirm he wants to continue
screenmessage = "This action creates hyperlinks from the data supplied" _
                & Chr(13) & "in a specified range.  The selected range must contain" _
                & Chr(13) & "the full path and file descriptor of the files to be" _
                & Chr(13) & "hyperlinked.  The displayed text for the hyperlink may" _
                & Chr(13) & "subsequently show (user choice) either the full path and" _
                & Chr(13) & "filename or just the filename.  Do you wish to continue?"
CreateHL = MsgBox(screenmessage, vbOKCancel, "Create Hyperlinks")

If CreateHL = 1 Then 'user selected "OK"
    'get the user range selection
    Set usrrange = get_user_range_selection()
    
    'if he did not select cancel then proceed
    usrrows = usrrange.Rows.count
    If Err.Number <> 0 Then
        Err.Clear
    Else
        'ask the user if he wants to display the filename and full path or just the filename
        pathmsg = "When the Hyperlink is created, the displayed text can be  " _
                  & Chr(13) & " the filename alone or the filename and whole path.  " _
                  & Chr(13) & " If you would like to display the whole path, select YES," _
                  & Chr(13) & "to display Filename only, select NO, or to quit select Cancel"
                  
        DispPath = MsgBox(pathmsg, vbYesNoCancel, "Text to display")
        'yes=6, no = 7, canc = 2
        
        'if the user did not select cancel then proceed
        If DispPath <> 2 Then
            'step through each cell in the range
            For Each thiscell In usrrange
                'if the cell holds a valid (existing) file
                celltext = thiscell.Text
                badname = False
                If celltext <> "" Then
                    If AL_FileExists(celltext) Then
                        'if the user selected full path then
                        If DispPath = 6 Then
                            'Text2disp = full cell content
                            text2disp = celltext
                        Else
                            'strip off the path and just use the filename alone
                            stripext celltext, ext, nameonly, Path, badname
                            text2disp = nameonly & ext
                        End If
                        
                        'if the cell holds a valid path & file name then
                        If Not badname Then
                            'create a hyperlink to it using the above text2disp
                            thiscell.Select
                            ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
                            Address:=celltext ', TextToDisplay:=text2disp
                            thiscell = text2disp
                        Else
                            'note the number of errors = numerrs
                            numerrs = numerrs + 1
                        End If
                    Else
                        'note the number of errors = numerrs
                        numerrs = numerrs + 1
                    End If
                Else
                    'note the number of errors = numerrs
                    numerrs = numerrs + 1
                End If
            'end For loop
            Next thiscell
        End If
    End If
    
    'if any errors were found, tell the user
    If numerrs > 0 Then MsgBox Str(numerrs) & " Errors were found.", vbOKOnly, "Warning!"
    
End If
End Sub

This calls get_user_range_selection(). You will find that function defined in a recent topic - see "Most useful UDFs"

It also calls AL_Fileexists(). Here is the code for that function:

Public Function AL_FileExists(FileName As String) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description:
'This function checks to see if the file (with path if given) <filename> exists.  If it does it
'returns true, otherwise false.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim num As Long
On Error Resume Next
num = FreeFile
Open FileName For Input As #num
If Err = 0 Then
    Close #num
    AL_FileExists = True
Else
    Err.Clear
    AL_FileExists = False
End If
End Function

However, I'm sure if you search through this board you'll find better versions of this function.

Tony

 

[Igawa29]

Thank you, I will take a look at this code and see if I can break it down for my needs. There are 4500 instences, so it is going to be one long if else statement, but worth it in the end not having to manually do it each month.

 

[N1GHTEYES]

I'm not quite sure what you mean by "one long if else statement".

I think you want code to:

1 Check through your existing hyperlinks and ensure that the displayed text just shows the filename rather than the path and filename.

2 Take a list of cells containing path & filenames and make them into hyperlinks, just showing the filenames.

The code I posted will (in Excel) do item 2 for you.

Item 1 should be quite easy: Use a For Each look to go through all the hyperlinks in your sheet or workbook or database or whatever using the .Hyperlinks collection. In each case, simply set the displayed text to show only the filename (i.e. remove the path section of the displayed text).

Where does the if / else come into it?

Tony

 

[Igawa29]

Sorry I just am not wrapping my mind around your code .. basically please see my "CODE" and I call it that because syntax wise it will not work but I hope to show my logic process in my mind.

Sub AL_HyperLinks_Create()

DispPath1 = \\somehow grabs the path from the field I need (multiple choices within this field)
DispPath2 = \\somehow grabs the path from the field I need (multiple choices within this field)
DispPath3 = \\somehow grabs the path from the field I need (multiple choices within this field)
DispPath4 = \\somehow grabs the path from the field I need (multiple choices within this field)
DispPath5 = \\somehow grabs the path from the field I need (multiple choices within this field)
DispPath6 = \\somehow grabs the path from the field I need (multiple choices within this field)


If DispPath1 = C:\Documents and Settings\Igawa\Desktop\Main_Source.xls 
Then  
 .TextToDisplay = Main_Source.xls 
Else
If DispPath1 = C:\Documents and Settings\Igawa\Desktop\Tables_Source.xls 
Then  
 .TextToDisplay = Tables_Source.xls 
End If
end sub

 

[N1GHTEYES]

I think maybe I'm the one who's being a bit thick here, but I'm really not clear what it is you are trying to do. Perhaps we are talking at cross-purposes.

Could you please specify in simple terms:
how your data is laid out
where you want to add hyperlinks
what the hyperlinks should refer to
what they should display
what your criteria are for deciding the above

I'll try to help if I can (bearing in mind that Access is a closed book to me) but at the moment I'm afraid I don't quite see what help you need.

Tony

 

[Igawa29]

Tony,

Appreciate your patience with me on this. Basically my data is one table that consists of 14 fields, 12 of which are hyperlink fields, and they link correctly (hyperlinks are already added).

These hyperlinks link to excel and other files on a network drive, like I said these links work, however it is the full path, which I don't want to display.

If I right click on the cel with the hyperlink in it I can edit the display text of the hyperlink, however with close to 3,000 unique hyperlinks I just simply cannot do this manually. Since the path is the same for all the hyperlinks except for the name of the file I was wondering if there would be a way to chop the path off of the hyperlink and just display the file name as the display text. I think that is what your code was trying to do but I wasn't sure.

Part two of my issue is more Access heavy which I am not sure you will know what I am trying to do. I want to be able to create hyperlinks to tables within the same Access Database. I know I can do this by right clicking on a blank cel and navigate to a table in the wizard and it will link, however for all the tables I need to add, I want a more vba type solution for this.

I hope I explained everything clearly, I appreciate you looking into this for me and giving me any tips you can think of.

 

[docjohn52]

Create a table in Access for your hyperlinks.

Use Dynamic SQL to query the database for the appropriate hyperlink.

 

[N1GHTEYES]

OK, so what you actually want is the code to determine which parts of a filespec are which - i.e. path & filename. There is a heap of code knocking around which does this. Probably the best is to use the filesystem object (you'll need a reference to VB scripting runtime library). Search this forum for filesystem object (or try the help) for details.

As an alternative, here is some code I wrote ages ago (and still use out of habit) from long before I'd even heard of the scripting runtime.

It is called stripext, it runs as a sub (you could easily reconfigure it as a function to return the pathless filename if you want) which takes a full filename & path string and splits it into path, nameonly and extension. It also sets a boolean "badname" to true if it encounters a filespec it cannot parse.

I called it in the code for AL_Hyperlinks_Create (shown above) but missed it, or I would have given you the code already.

Here is the code:

Public Sub stripext(fname As String, ext As String, nameonly As String, Path As String, badname As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description:
'This sub parses a file and path name into it's component parts.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim reverse As String
Dim namelength As Integer, dotpos As Integer, pathlength As Integer, slashhpos As Integer
Dim extlength As Integer, colonpos As Integer, nameonlylength As Integer
Dim i As Long
Dim slashpos As Long

badname = False
namelength = Len(fname)
If namelength > 0 Then
    reverse = ""
    For i = 0 To namelength - 1
        reverse = reverse & Mid(fname, namelength - i, 1)
    Next i
    dotpos = namelength + 1 - InStr(1, reverse, ".")
    slashpos = namelength + 1 - InStr(1, reverse, "\")
    colonpos = namelength + 1 - InStr(1, reverse, ":")
    If colonpos > namelength Then colonpos = slashpos
    If dotpos > 0 Then
        extlength = namelength + 1 - dotpos
        If extlength <= 4 And extlength <= namelength Then
            ext = Mid(fname, dotpos, extlength)
        Else
            badname = True
        End If
    Else
        extlength = 0
        dotpos = Len(fname)
    End If
    
    If slashpos >= colonpos Then
        pathlength = slashpos
    Else
        pathlength = colonpos
    End If
    
    If pathlength > dotpos Or badname Then
        badname = True
    Else
        If pathlength > 0 Then
            Path = Mid(fname, 1, pathlength)
        Else
            Path = ""
        End If
        
        nameonlylength = namelength - pathlength - extlength
        If nameonlylength > 0 Then
            nameonly = Mid(fname, pathlength + 1, nameonlylength)
        Else
            nameonly = ""
        End If
    End If
Else
    badname = True
End If
End Sub

So what I think you need to do is:
use the worksheet.hyperlinks collection to get the displayed text of each hyperlink,
use stripext to get the nameonly & extension and to replace the displayed text with just that

Presumably Access has a hyperlinks collection associated with an appropriate object.

I'm sorry it took me so long to grasp what you were after. I thought the problem was the hyperlinks, not the parsing.

Tony

 

[N1GHTEYES]

Igawa29 - did that solve your problems?

 

[Igawa29]

Tony,

I am still playing around with your code in Access, and I am trying to make sure I understand it, and how to apply it to my own program. Sorry it's taking me awhile to do it.

 

[Igawa29]

I was thinking there might be a simple answer to this but I guess it's more complicated than that. This is what I was playing around with in Excel and I thought it could be applied to Access.

Sub Macro1()
    Range("A76").Select
    Selection.Hyperlinks(1).TextToDisplay = "Member.xls"
End Sub

 

[PHV]

A starting point:
.TextToDisplay = Mid(.Address, 1 + InStrRev(.Address, "\"))

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[N1GHTEYES]

If I understand what you want, the code you need is something like the following:

dim sht as worksheet
dim H as hyperlink
dim badname as boolean
dim hltxt as string, nameonly as string, ext as string, path as string
set sht = activesheet
for each H in sht.hyperlinks
  txt.H.texttodisplay
  stripext txt, ext, nameonly, path, badname
  if not badname then h.texttodisplay = nameonly & ext
next H

... at least it is for the Excel part.
If you want to do this for all the sheets in a workbook, lose the line:
set sht = activesheet

and wrap:
For each sht in activeworkbook.worksheets
(code here)
next sht

around it all instead.

Tony

 

[Igawa29]

Yep looks like I have a working model now, thanks everyone for your help. Glad I could finally work through that one.

The only issue I have left is having a hyperlink within my table open another table, but I think I will have to do some research on that.

Thanks again.

 

[N1GHTEYES]

As I pointed out, I'm almost totally ignorant of Access, but if it were an Excel issue, I would record a macro whilst creating the type of hyperlink I wanted, then see how the recorded code had done it. Then all you have to do is modify the specific recorded code to fit your more general requirements.

Does Access not support recording macros?

Tony

 

[Igawa29]

Tony,
I can't seem to find it on Access, so my guess is my version doesn't support recording macros, I do record macros all the time in Excel, very helpful tool.

 

[N1GHTEYES]

A quick googling shows you are right. Access does not seem to support capturing macros. How odd.

Maybe this link will help?

http://www.pcreview.co.uk/forums/import-excel-hyperlink-column-into-access-table-t3330404.html

It looks like a bit of a faff, but maybe you could have a play with it get something useful? Anyway, I hope you find you're solution.

Good luck,
Tony

 

[Igawa29]

Tony,

Thanks for the link, I hope to have a solution. Appreciate all the help.