Probleme mit Hyperlink in Email

Sub MailAnVeränderte()
Dim olApp As Object
Dim Message1, Message2 As String
Dim objGroupWise As Object
Dim objAccount As Object
Dim objMessages As Object
Dim objMessage As Object
Dim objMailBox As Object
Dim objRecipients As Object
Dim objRecipient As Object
Dim objAttachment As Object
Dim objAttachments As Object
Dim objMessageSent As Variant
Dim I, lastRecipients As Integer
Dim Subject As String, Attachment As String, Recipient As String, Bodytext As String
Message1 = VeränderteInfo & _
"Anzahl pro Technologie" & vbLf & _
"------------------------------" & _
vbLf & _
"UC: " & TC_UF_320 & vbLf & _
"FC: " & TC_F_310 & vbLf & _
"TC: " & TC_TC_340 & vbLf & _
"HC: " & TC_HC_330 & vbLf & vbLf & _
vbLf & _
vbLf & _
"Legende Veränderungstyp:" & vbLf & _
"------------------------------" & _
vbLf & _
"0 = Zeitpunkt-, Zeitraumänderung" & vbLf & _
"1 = Mengenänderung" & vbLf & _
"2 = Neue Meldung" & _
vbLf & _
vbLf & _
"******************************" & _
vbLf & _
vbLf & _
"Woche - Änderungstyp - Technologie - Art. Nummer - Art. Bezeichnung - Meldungstyp" & vbLf & _
"------------------------------" & _
vbLf & _
vbLf
Message2 = VeränderteInfo2 & _
vbLf & _
vbLf & _
"Mit freundlichen Grüssen" & vbLf & _
"DM-Planungsteam" & vbLf & _
"Pfad zum Cockpit" & vbLf & _
vbLf & _
' Hier würde ich gerne den Link als Hyperlink einfügen.
"J:\AKTIONEN\Cockpit Aktionen\2006\InOutEventZusammenzug Version 5.0 - 2006.xls" & vbLf
On Error GoTo Errorhandling
lastRecipients = Sheets("EmpfängerInfomail").Range("A1").CurrentRegion.Rows.Count
'Betreffzeile füllen
Subject = "Veränderte Meldeblätter! " & Date
'Anhang deklarieren
'Attachment = ThisWorkbook.Path & "\" & ActiveWorkbook.Name
'Mail Hauptnachrichten Text
Bodytext = Message1
Bodytext = Bodytext & Message2
'Übergabe an Groupwise
Set objGroupWise = CreateObject("NovellGroupWareSession")
Set objAccount = objGroupWise.Login
Set objMailBox = objAccount.MailBox
Set objMessages = objMailBox.Messages
Set objMessage = objMessages.Add("GW.MESSAGE.MAIL", "Draft")
Set objRecipients = objMessage.Recipients
'Mailempfänger für jeden Adressant eine eigene übergabe definieren.
For I = 1 To lastRecipients
Recipient = Sheets("EmpfängerInfomail").Range("A" & I).Value
Set objRecipient = objRecipients.Add(Recipient)
Next I
'Set objAttachments = objMessage.Attachments
'muss deaktiviert werden wenn kein Anhang definiert ist in Variable Attachment
'Set objAttachment = objAttachments.Add(Attachment)
With objMessage
.Subject = Subject
.Bodytext = Bodytext
End With
Set objMessageSent = objMessage.Send
ExitHere:
Set objGroupWise = Nothing
Set objAccount = Nothing
Set objMailBox = Nothing
Set objMessages = Nothing
Set objMessage = Nothing
Set objRecipients = Nothing
Set objAttachments = Nothing
Set objRecipient = Nothing
Set objAttachment = Nothing
Exit Sub
Errorhandling:
MsgBox Err.Description & " " & Err.Number
Resume ExitHere
End Sub