从Excel范围填充Outlook中的列表框 – 获取单元格的超链接

我正在尝试使用Excel范围中的数据在Outlook VBA中填充多列列表框。

我已经设法使用代码到目前为止工作：

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 

与Excel范围是2列 – 第一列是一个标题和第二列是一个Word文档的超链接单元格。

有了上面的代码，我可以得到填充的列表框好，但我想要做的是当其中一个行被选中，我想能够find相应的单元格中的超链接。

例如，范围如下所示：

 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") 

使用代码我得到超链接文本（例如，“链接到指南”），但我需要什么超链接位置（例如，“guide1.doc”）。

有没有办法将超链接位置加载到列表框中，而不必重写Excel文件？ （它是由其他人维护的，所以这是可能的，但要花很长时间才能这样做）。

我希望我清楚自己在做什么！

有没有人有任何想法？

谢谢

Answer 1

你的问题很清楚。 Excel有一个Hyperlinks集合，它允许您获取Hyperlinks的文本和地址。 这个集合可以是一个范围的属性，所以很容易做到你想要的。

第一个例子假定要显示的文本位于超链接（一般情况）上：

 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 

第二个例子是文本在一个单元格中与超链接单元格向右的特定情况：

 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