outlook'da macro ile hyperlink(köprü) yapmak

[cosarx]

herkese merhabalar;
excel tablosunda a1 hücresinde oluşturduğum c diskindeki dosyayı gösteren bir köprüm var. outlook da body kısmına bu a1 hücresindeki yazıyı macro kod ile ekliyorum.fakat yazıyı köprü özelliğiini de koruyarak aktarmak istiyorum.fakat aşagıdaki kodla sadece yazıyı hyperlinkli olmayan bir şekilde aktarıyor.bu sorunu nasıl çözebilirim?

Sub KopruYap()
Dim Adres As String, Aciklama As String, Yol As String

Yol = "c:\"

Adres = Range("A1") & Range("C1")
Aciklama = Range("A1").Value & Range("C1").Value
Range("A1").Hyperlinks.Add Anchor:=Range("A1"), Address:=Yol & Adres & ".htm" _
, TextToDisplay:=Aciklama

'yukardaki kod a1 hücresindeki yazıya köprü ekliyor...
'aşagıdaki kod ise a1 deki değeri outlooka ekliyor..

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim konu As String
Dim day As String
Dim fark As Integer
Dim saat As String
Dim tarih As Integer

tarih = 0
fark = 1
saat = " 08:30_17:30 -"

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

If Hour(Now) < 12 Then
fark = 0
tarih = 1
saat = " 16:30_09:30 "
End If
If Weekday(Date + fark) = 2 Then gun = "- PAZAR -"
If Weekday(Date + fark) = 3 Then gun = "- PAZARTESİ -"
If Weekday(Date + fark) = 4 Then gun = "- SALI -"
If Weekday(Date + fark) = 5 Then gun = "- ÇARŞAMBA -"
If Weekday(Date + fark) = 6 Then gun = "- PERŞEMBE -"
If Weekday(Date + fark) = 7 Then gun = "- CUMA -"
If Weekday(Date + fark) = 1 Then gun = "- CUMARTESİ -"


konu = "RAPOR (" & saat & gun & Date - tarih & " )"

Set rng = Nothing
Set rng = ActiveSheet.UsedRange
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "COSAR"
.CC = ""
.BCC = ""
.Subject = konu
.HTMLBody = Range("A1")
' .Send
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub