java 邮件 超链接_将Excel范围中的超链接传输到Outlook电子邮件

我正在尝试从excel范围(rng 1到6)创建一个电子邮件，其中包含A列和D列中每个单元格的超链接 . 以下是为这些范围创建超链接的代码示例 . 一切正常 .

ActiveSheet.Hyperlinks.Add Anchor:=ActiveWorkbook.Sheets("Overdue").Range("A" & D2), _

Address:="some address" & ActiveWorkbook.Sheets("Overdue").Range("A" & D2).Value

ActiveSheet.Hyperlinks.Add Anchor:=ActiveWorkbook.Sheets("Overdue").Range("D" & D2), _

Address:="some other address" & ActiveWorkbook.Sheets("Overdue").Range("A" & D2).Value

然后我有以下代码，从excel范围(rng1到6)创建一个电子邮件 . 创建电子邮件时，超链接不会传输到Outlook . 文本带有下划线，好像有一个超链接但不可点击 .

Sub Mail_Body()

Dim rng1 As Range

Dim OutApp As Object

Dim OutMail As Object

Dim wb2 As Workbook

Dim MyDate, Weeknr, MyFileName, MyTime, MyMonth

Dim Mail1 As String

Dim Mail2 As String

Dim Subject As String

Dim Warr As String

Dim rng2 As Range

Dim rng3 As Range

Dim rng4 As Range

Dim rng5 As Range

Dim rng6 As Range

Dim Subject_email As String

Application.ScreenUpdating = False

Application.EnableEvents = False

nPath = Environ("temp") & "\" & ThisWorkbook.Sheets("Lists").Range("AA1").Value

Set wb2 = Workbooks.Open(nPath)

D2 = Sheets("Critical").Range("A1").Offset(Sheets("Critical").Rows.Count - 1, 0).End(xlUp).Row

D3 = Sheets("High").Range("A1").Offset(Sheets("High").Rows.Count - 1, 0).End(xlUp).Row

D4 = Sheets("Low").Range("A1").Offset(Sheets("Low").Rows.Count - 1, 0).End(xlUp).Row

D5 = Sheets("Other").Range("A1").Offset(Sheets("Other").Rows.Count - 1, 0).End(xlUp).Row

D6 = Sheets("Overdue").Range("A1").Offset(Sheets("Overdue").Rows.Count - 1, 0).End(xlUp).Row

Set rng = Nothing

Set rng1 = Nothing

Set rng2 = Nothing

Set rng3 = Nothing

Set rng4 = Nothing

Set rng5 = Nothing

Set rng6 = Nothing

Set rng2 = Sheets("Critical").Range("A1:J" & D2).SpecialCells(xlCellTypeVisible)

Set rng3 = Sheets("High").Range("A1:J" & D3).SpecialCells(xlCellTypeVisible)

Set rng4 = Sheets("Low").Range("A1:J" & D4).SpecialCells(xlCellTypeVisible)

Set rng5 = Sheets("Other").Range("A1:J" & D5).SpecialCells(xlCellTypeVisible)

Set rng6 = Sheets("Overdue").Range("A1:L" & D6).SpecialCells(xlCellTypeVisible)

Set OutMail = Nothing

Set OutApp = Nothing

On Error Resume Next

Set OutApp = GetObject(, "Outlook.Application")

If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")

On Error GoTo 0

'MsgBox OutApp

Set OutMail = OutApp.CreateItem(0)

Dim Session As Object

Set Session = OutApp.GetNamespace("MAPI")

Session.Logon

Create email

With OutMail

.To = Mail1

.CC = Mail2

.BCC = ""

.Subject = Subject_email

.HTMLBody = "Overview:" & "
" & RangetoHTML(rng1) _

& "
" & "Critical" & "
" & RangetoHTML(rng2) & "
" & "High" _

& "
" & RangetoHTML(rng3) & "
" & "Low" & "
" & RangetoHTML(rng4) _

& "
" & "Other" & "
" & RangetoHTML(rng5) _

& "
" & "Overdue" & "
" & RangetoHTML(rng6)

.Attachments.Add nPath '.FullName

.Recipients.ResolveAll

.Display '.Send

End With

我无法共享此代码的输出，但如上所述，会发生的事情是Excel工作表中的超链接不会传输到Outlook电子邮件 . 它们是蓝色的并带有下划线但没有超链接 .

如何将excel的活动超链接转移到outlook？我一直无法找到符合我特定需求的预先存在的解决方案 .