Access to Excel Hyperlinks, New question checked old posts

[Frustratee]

Sorry guys, this is killing me.

I have been fighting this issue for several weeks, to no avail. I am exporting the results of a query to an excel sheet, with one of the columns being from a field of hyperlinks that link to files on the shared drive.

I CANNOT get the hyperlinks to be assigned. I can change the field name, but not the hyperlink address. Can't figure it out.

1) I have a header row
2) Column 16 is where the hyperlinks are

Here it is:

Private Sub Hiring_submit_cmd_Click()
' Excel Handling
Dim oExcel As Excel.Application
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet
Dim SaveString As String
Dim sa
Dim HyperCount As Long
Dim RanCell As Excel.Range
Dim StrTxt As String
Dim HyperlinkTxt As String
 
For HyperCount = 2 To oWB.Sheets(1).UsedRange.Rows.Count
     Set RanCell = oWB.ActiveSheet.Cells(HyperCount, 16)
 
     StrTxt = StrConv(RanCell, vbProperCase)
     If Len(StrTxt) > 1 Then _
          call oWB.ActiveSheet.Hyperlinks.Add(anchor:=RanCell, _
               Address:=StrTxt, TextToDisplay:=StrTxt)
     Next HyperCount

Thanks

[NeoPa]

I know you've already checked and found How to export a hyperlink field from Access to Excel - VBA (I had to remove the post you put in there before you realised you needed to post in your own thread).

This can help you I'm sure, but first you need to think about the basics of your code. It appears that there is nothing in your code which establishes any link into Excel. Check out Application Automation first.

Your code seems to be missing so much it's hard to know where you're at. Let's get the basics sorted out first then we can move on from there to fixing the hyperlink situation.

[Frustratee]

Roger, thanks NeoPa.

Let me post all of it. I was thinking that I would just cut to the chase of it, but here we go:

Private Sub Hiring_submit_cmd_Click()
Dim VarItem As Variant
' Query Handling
Dim dbs As Database
Dim qryname As String
Dim QryDef As QueryDef
' Excel Handling
Dim oExcel As Excel.Application
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet
Dim SaveString As String
Dim sa
Dim HyperCount As Long
Dim RanCell As Excel.Range
Dim StrTxt As String
Dim HyperlinkTxt As String
 
 
'
' Development of SQLStr SQL statement, works fine...
'
 
' Perform Query--------------------
Set dbs = CurrentDb
qryname = "HiringQuery"
'Delete old query
For Each QryDef In dbs.QueryDefs
    If (QryDef.Name = qryname) Then dbs.QueryDefs.Delete qryname
Next QryDef
Set QryDef = dbs.CreateQueryDef(qryname, SQLStr)
' Execute query
DoCmd.SetWarnings False
DoCmd.OpenQuery "HiringQuery"
DoCmd.Close acQuery, qryname
DoCmd.SetWarnings True
 
' Output to Excel-----------------
SaveString = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & _
    "Candidate Hiring Query " & Format(Now(), "ddmmmyyyy") & " " & Format(Now(), "hhnn") & ".xls"
On Error GoTo Errorhandler
 
DoCmd.Echo False
DoCmd.SelectObject acTable, , True
DoCmd.OutputTo acOutputQuery, "HiringQuery", acFormatXLS, SaveString
DoCmd.SelectObject acTable, , True
DoCmd.RunCommand acCmdWindowHide
DoCmd.Echo True
 
Set oExcel = New Excel.Application
Set oWB = oExcel.Workbooks.Open(SaveString)
'Format Headers
oWB.ActiveSheet.Range("A1").Value = "Last Name"
oWB.ActiveSheet.Range("B1").Value = "First Name"
oWB.ActiveSheet.Range("C1").Value = "M.I."
oWB.ActiveSheet.Range("G1").Value = "Possible Reqs"
oWB.ActiveSheet.Range("H1").Value = "Significant Comments"
oWB.ActiveSheet.Range("I1").Value = "Yrs Experience"
oWB.ActiveSheet.Range("J1").Value = "Service"
oWB.ActiveSheet.Range("L1").Value = "Degree Details"
oWB.ActiveSheet.Range("M1").Value = "Number of Schools"
oWB.ActiveSheet.Range("N1").Value = "Deployments"
oWB.ActiveSheet.Range("O1").Value = "Received"
oWB.ActiveSheet.Range("P1").Value = "Resume Path"
**************************************************************************
' Add hyperlinks
For HyperCount = 2 To oWB.Sheets(1).UsedRange.Rows.Count
    Set RanCell = oWB.ActiveSheet.Cells(HyperCount, 16)
 
    StrTxt = StrConv(RanCell, vbProperCase)
    If Len(StrTxt) > 1 Then _
        Call oWB.ActiveSheet.Hyperlinks.Add(anchor:=RanCell, _
                                Address:=RanCell, TextToDisplay:=RanCell)
 
Next HyperCount
*************************************************************************
oWB.ActiveSheet.Range("Q1").Value = "LOI Path"
oWB.ActiveSheet.Rows("1:1").EntireRow.AutoFit
oWB.ActiveSheet.Columns("A:n").EntireColumn.AutoFit
 
oWB.Save
Set oWS = Nothing
If Not oWB Is Nothing Then oWB.Close
Set oWB = Nothing
oExcel.Quit
Set oExcel = Nothing
sa = Shell("C:\Program Files\Microsoft Office\OFFICE11\excel.exe " & _
    Chr$(34) & SaveString & Chr$(34), vbNormalFocus)
Exit Sub
 
Errorhandler:
 
    If Err.Number = 2302 Then
        MsgBox ("Close Excel file and try again.")
'    Else
'        MsgBox ("Undefined BPMP error.")
    End If
End Sub

[NeoPa]

Generally you can do (and it's a good idea to where possible), but you must include the relevant data or your code will not be recognisable.

Had you simply included a comment saying briefly what the code had done and what the object variables were pointing to (much as you did for the code formulating the SQL string) that could also have worked.

Anyway, no harm, no foul. I'll see if I can find some time to go through this in some detail soon. Just coming to end of Lunch-hour at the moment so will have to squeeze in as and when.

[NeoPa]

You mentioned earlier that the links you're using are local files rather than web references. One major difference (that I think is actually your problem) is that in my code I knew all entries that needed converting were already fully qualified HTTP references (http://...). If you want this to work correctly for local file references you need to ensure that they follow the web addressing convention for local files. IE. "FILE://...".

In short, I expect that if you're using addresses of the form "C:\Temp\MySpreadsheet.xls" you will have problems. However, if you were to use (or doctor in the code to use) addresses of the form "FILE://C:\Temp\MySpreadsheet.xls" you would have no such problems.

Try this out and let us know how you get on.

[Frustratee]

In short, I expect that if you're using addresses of the form "C:\Temp\MySpreadsheet.xls" you will have problems. However, if you were to use (or doctor in the code to use) addresses of the form "FILE://C:\Temp\MySpreadsheet.xls" you would have no such problems.

Try this out and let us know how you get on.

You were correct that this is what I was doing. However, after inserting the following (where AddressTxt is defined as a String), the field shows up looking like a hyperlink (as it did before...blue and underlined) but with no address linked:

For HyperCount = 2 To oWB.Sheets(1).UsedRange.Rows.Count
    Set RanCell = oWB.ActiveSheet.Cells(HyperCount, 16)
    AddressTxt = "FILE://" & StrConv(RanCell, vbProperCase)
    StrTxt = StrConv(RanCell, vbProperCase)
    If Len(StrTxt) > 1 Then _
        oWB.ActiveSheet.Hyperlinks.Add anchor:=RanCell, _
                                Address:=AddressTxt, TextToDisplay:=StrTxt
 
Next HyperCount

Setting Address and TextToDisplay directly to "FILE://" & Rancell and Rancell, respectively, yield a runtime error '5' invalid procedure call or argument. Same error occurs when I CALL the hyperlinks.add and use parentheses.

:( Was really hoping your suggestion would work.

[NeoPa]

Try something like this :

With oWB.ActiveSheet
  For HyperCount = 2 To .UsedRange.Rows.Count
    Set RanCell = .Cells(HyperCount, 16)
    StrTxt = StrConv(RanCell, vbProperCase)
    If Len(StrTxt) > 1 Then
      AddressTxt = "FILE://" & StrText
      Call .Hyperlinks.Add(Anchor:=RanCell, _
                           Address:=AddressTxt, _
                           TextToDisplay:=StrTxt)
    End If
  Next HyperCount
End With

I've tried the effect of this code on some basic dummy data (in Excel 2003) and it worked fine for me (it linked to the spreadsheet I had in my original data).

In truth, I understand why you an error 5 (using a Range reference for TextToDisplay which requires a string variable), but not why your other attempts failed. Try with this and see what you get. Does it link when clicked on?

[Frustratee]

... negative.

It couldn't be a reference library thing, could it? Here are the ones I have:

VBA
Access 11.0
OLE Automation
DAO 3.6
ActiveX Data Objects 2.1
Excel 11.0
Office 11.0
Outlook 11.0

That's the only other thing I can think of. All data gets from the correct Access records, is formatted properly, even the hyperlink fields are blue and underlined, but just no data in the hyperlink address field.

Another thing I have noticed, an anomoly. You know how each line is autocorrected for punctuation after that line has been left? Well, no matter what way I type in 'anchor,' it stays that way: AnChOr.

Regardless, thanks for the time in this.

[NeoPa]

Some interesting points. I can only say that I don't know of any link to References that might explain this.

What I will do is first explain the AnChOr:= thing, then suggest a test for you to carry out.

The VBA editor will generally correct all items that it has knowledge of. This includes reserved words as well as any name which has already been defined anywhere in your code. It will handle named parameters of procedures if they are defined in your code, but unless there is a specific declaration of the procedure and all its parameters (there is none for .Hyperlinks.Add()), then it will not have access to the correct capitalisation of the word. In short, for inbuilt procedures don't expect that to work (although it will for ones you've written yourself).

Now, what I want you to try out is the following :
Open a new workbook (Ctrl-N) in Excel and enter the address of one of your Excel files into cell A1 in normal Windows Explorer format (C:\Home\YourName\Excel\Test.xls for instance - but the file should exist for the test to make sense).

When you navigate away from the cell there should be no hyperlink set up.

Now, hit Alt-F11 (open and switch to the VBA Editor) and Ctrl-G (Switch to the Immediate Pane).

Enter the following and hit enter (use Copy / Paste from here) :

Call ActiveSheet.Hyperlinks.Add(Anchor:=Range("A1"), Address:="FILE://" & Range("A1").Text, TextToDisplay:=Range("A1").Text)

Do you find this link works when you click on it (It does for me)?

[Frustratee]

Yes, doing that in excel does work...

[NeoPa]

That tells me that the code should work assuming the data I expect.

Try replacing the last bit with this (I've added some lines to show some extra information) and see what it shows in the Immediate Pane (Ctrl-G). I'd prefer the results for a single cell only if possible, but if not then dump the lot in a post and we'll see what we can determine.

With oWB.ActiveSheet
  For HyperCount = 2 To .UsedRange.Rows.Count
    Set RanCell = .Cells(HyperCount, 16)
    StrTxt = StrConv(RanCell, vbProperCase)
    If Len(StrTxt) > 1 Then
      AddressTxt = "FILE://" & StrText
Debug.Print RanCell.Address, RanCell.Text
Debug.Print AddressTxt
Debug.Print StrTxt
      Call .Hyperlinks.Add(Anchor:=RanCell, _
                           Address:=AddressTxt, _
                           TextToDisplay:=StrTxt)
    End If
  Next HyperCount
End With

[Frustratee]

Using your code during the Access export:

    with owb.activesheet
For HyperCount = 2 To .UsedRange.Rows.Count
        Set RanCell = .Cells(HyperCount, 16)
        StrTxt = StrConv(RanCell, vbProperCase)
        If Len(StrTxt) > 1 Then
            AddressTxt = "FILE://" & StrTxt
            Debug.Print RanCell.Address, RanCell.Text
            Debug.Print AddressTxt
            Debug.Print StrTxt
            .Hyperlinks.Add AnChoR:=RanCell, _
                                Address:=AddressTxt, _
                                TextToDisplay:=StrTxt
        End If
    Next HyperCount
end with

I got the following:

$P$2          G:\path\file.pdf
FILE://G:\path\file.pdf
G:\path\file.pdf

The hyperlinks did not link.

I used the following code in the exported excel sheet:

Dim hypercount As Long
Dim rancell As Excel.Range
Dim StrTxt As String
Dim AddressTxt As String
 
With ActiveSheet
 
  For hypercount = 2 To .UsedRange.Rows.Count
    Set rancell = .Cells(hypercount, 16)
    StrTxt = StrConv(rancell, vbProperCase)
    If Len(StrTxt) > 1 Then
      AddressTxt = "FILE://" & StrText
Debug.Print rancell.Address, rancell.Text
Debug.Print AddressTxt
Debug.Print StrTxt
      Call .Hyperlinks.Add(Anchor:=rancell, _
                           Address:=AddressTxt, _
                           TextToDisplay:=StrTxt)
    End If
  Next hypercount
End With

And, interestingly, there was no path after "FILE://":

$P$2          G:\path\file.pdf
FILE://
G:\path\file.pdf

However, the hyperlink DID work. In the working links, after right-clicking on any one of them and selecting 'Edit Hyperlink', even though the link works, the address line is blank. What the hell...

[NeoPa]

That's because in the first one you typed in my code and in the second you copy / pasted it in.

There is a bug in my code at line #6 where it uses the variable name StrText instead of StrTxt. It's always VERY important to use Copy / Paste. In this case it was important to copy the error in order that the whole makes sense. Strange I know.

Possibly try it again with all the same code (in this case clearly fix this bug first).