Populating a listbox in Outlook from an Excel Range - getting a cell's hyperlink

Question

I'm trying to populate a multicolumn listbox in Outlook VBA with data from an Excel range.

I've managed to get it working so far using the code:

Private Sub CommandButton1_Click()

'Late binding.  No reference to Excel Object required.
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim cRows As Long
Dim I As Long
  Set xlApp = CreateObject("Excel.Application")
  'Open the spreadsheet to get data
  Set xlWB = xlApp.Workbooks.Open("Query Log.xlsx")
  Set xlWS = xlWB.Worksheets(1)
  cRows = xlWS.Range("Guides").Rows.Count - xlWS.Range("Guides").Row + 1
  ListBox1.ColumnCount = 2
  'Populate the listbox.
  With Me.ListBox1
    For I = 2 To cRows
       'Use .AddItem property to add a new row for each record and populate column 0
      .AddItem xlWS.Range("Guides").Cells(I, 1)
      'Use .List method to populate the remaining columns
      .List(.ListCount - 1, 1) = xlWS.Range("Guides").Cells(I, 2)
    Next I
  End With
  'Clean up
  Set xlWS = Nothing
  Set xlWB = Nothing
  xlApp.Quit
  Set xlApp = Nothing
lbl_Exit:
  Exit Sub
End Sub

with the Excel range being 2 columns - first column being a title and the second column being a hyperlinked cell to a Word document.

With the code above I can get the listbox populated fine, but what I want to do is when one of the rows has been selected I want to be able to find out the hyperlink that is in the corresponding cell.

eg, the range looks like:

Guide 1  |  Link to guide (<--- hyperlinked to "guide1.doc")
Guide 2  |  Link to guide (<--- hyperlinked to "guide2.doc")
Guide 3  |  Link to guide (<--- hyperlinked to "guide3.doc")
Guide 4  |  Link to guide (<--- hyperlinked to "guide4.doc")

Using the code I get back the hyperlink text (eg, "Link to guide") but I need what the hyperlink location is (eg, "guide1.doc").

Is there any way to load the hyperlink location into the listbox without having to rewrite the Excel file? (it's maintained by someone else so it's possible, but would take them a very long time to do so).

I hope I'm clear in what I'm trying to do!

Does anyone have any ideas?

Thanks

Answer 1

You are clear in your question. Excel has a Hyperlinks collection which allows you to get the text and address of a hyperlink. This collection can be a property of a range, so it's quite easy to do what you want.

The first example assumes that the text to display is on the hyperlink (general case) :

Private Sub CommandButton1_Click()

    'Late binding.  No reference to Excel Object required.

    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
    Dim cRows As Long
    Dim hLink As Hyperlink
    Dim I As Long

    Set xlApp = CreateObject("Excel.Application")
    'Open the spreadsheet to get data
    Set xlWB = xlApp.Workbooks.Open("Query Log.xlsx")
    Set xlWS = xlWB.Worksheets(1)

    ListBox1.ColumnCount = 2

    'Populate the listbox.
    With Me.ListBox1

        For Each hLink In xlWS.Range("Guides").Hyperlinks

            'Use .AddItem method to add a new row for each record and populate column 0
            .AddItem hLink.TextToDisplay
            'Use .List method to populate the remaining columns
            .List(.ListCount - 1, 1) = hLink.Address

        Next hLink

    End With
    'Clean up
    Set xlWS = Nothing
    Set xlWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing
lbl_Exit:
  Exit Sub
End Sub

The second example is for the specific case where the text is in a cell apart with the hyperlink one cell to the right:

Private Sub CommandButton1_Click()

    'Late binding.  No reference to Excel Object required.

    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
    Dim cRows As Long
    Dim rngGuide As Range
    Dim I As Long

    Set xlApp = CreateObject("Excel.Application")
    'Open the spreadsheet to get data
    Set xlWB = xlApp.Workbooks.Open("Query Log.xlsx")
    Set xlWS = xlWB.Worksheets(1)

    Set rngGuide = xlWS.Range("Guides")

    ListBox1.ColumnCount = 2

    'Populate the listbox.
    With Me.ListBox1

        For I = 1 To rngGuide.Rows.Count

            'Use .AddItem method to add a new row for each record and populate column 0
            .AddItem rngGuide.Cells(I, 1).Value

            'Use .List method to populate the remaining columns
            .List(.ListCount - 1, 1) = rngGuide.Offset(I - 1, 1).Resize(1, 1).Hyperlinks(1).Address

        Next I

    End With
    'Clean up
    Set xlWS = Nothing
    Set xlWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing
lbl_Exit:
  Exit Sub
End Sub