Envio de correo con link a web

Dim OutApp As Outlook.Application, OutMail As Outlook.MailItem
Dim oAccount As Outlook.Account

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    For Each oAccount In OutApp.Session.Accounts
       If oAccount = "xxxx@aaaa.es" Then
          OutMail.SendUsingAccount = oAccount
       End If
    Next

        With OutMail

.To = Me.ListaDestino
        '    .CC = ""           'copia conocimiento
        '    .BCC = ""          'copia oculta
            .Subject = Me.Asunto
            .BodyFormat = olFormatHTML
            .HTMLBody = "<HTML><BODY>" & Replace(Me.Mensaje, vbCrLf, " ") & " " _
                & "" _
                & "Tecsys Proyectos Informáticos S.L. Mihura " _
                & "E-mail:  xxxx@xxxxx.es " _
                & "" _
                & "La información contenida en este mensaje y/o archivo(s) adjunto(s), enviada desde XXXXXXXXXXXXXXXXXXXXXX SL, es confidencial" _
                & "/privilegiada y está destinada a ser leída sólo por la(s) persona(s) a la(s) que va dirigida. Le recordamos que sus datos han sido" _
                & " incorporados en el sistema de tratamiento de XXXXXXXXXXXX SL y que siempre y cuando se cumplan los requisitos" _
                & " exigidos por la normativa, usted podrá ejercer sus derechos de acceso, rectificación, limitación de tratamiento, supresión," _
                & " portabilidad y oposición/revocación, en los términos que establece la normativa vigente en materia de protección de datos," _

                & "</font>" _
                & "</BODY></HTML>"
            .Save
            'adjuntos
            For gl_integer = 0 To Me.ListaAdjuntos.ListCount - 1
                If Not IsNull(Me.ListaAdjuntos.ItemData(gl_integer)) Then
                    .Attachments.Add (Me.ListaAdjuntos.ItemData(gl_integer))
                End If
            Next

            If Accion = "Ver" Then
                .Display    'Lo vemos
              Else
                .Send       'Lo enviamos
            End If
        End With

    Set OutMail = Nothing
    Set OutApp = Nothing