Send PDF med link til email

Hej

Jeg har skrevet denne kode til at sende et faneblad som PDF. Hvordan får jeg den oprettet email til at hente adressen i celle B9?

Koden
Sub LavPDFOgSendViaEmail()

Dim DataSti As String
Dim Filnavn As String
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
Dim OutlookPrg As Object
Dim OutlookMail As Object
Set OutlookPrg = CreateObject("Outlook.Application")
Set OutlookMail = OutlookPrg.CreateItem(0)

DataSti = objFolders("desktop") & Application.PathSeparator
Filnavn = ActiveSheet.Name & ".pdf"

ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=DataSti & Filnavn, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

On Error Resume Next
With OutlookMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Hermed fremsendes " & Filnavn
    .Body = "Hermed fremsendes " & Filnavn & vbCrLf & vbCrLf & "Med venlig hilsen" & vbCrLf & "Excel-regneark.dk"
    .Attachments.Add (DataSti & Filnavn)
    .Display
End With
On Error GoTo 0

Kill (DataSti & Filnavn)

Set OutlookMail = Nothing
Set OutlookPrg = Nothing
Set objFolders = Nothing
End Sub