VB Lav mail med vedhæfted filer

Hey jeg har prøver at få en vb kode til også at vedhæfte filer men uden held

er der nogle som kan hjælpe med det!?

fil navnene kommer fra cellerne + en fast text og .pdf
og et fast dir.

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long


Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim r As Integer, x As Double
    Dim Vedhæft_1a As String
    Dim Vedhæft_2a As String
    Dim Vedhæft_3a As String
    Dim Vedhæft_1b As String
    Dim Vedhæft_2b As String
    Dim Vedhæft_3b As String
    Dim Dir As String
    Set olNewMail = CreateItem(olMailItem)
   
    Dir = "G:/test/"
   
    'Kun hvis celler = talværdi
    Vedhæft_1a = Dir & Cells(r, 4) & "KL.pdf"
    Vedhæft_1b = Dir & Cells(r, 4) & "KV.pdf"
    Vedhæft_2a = Dir & Cells(r, 10) & "Kl.pdf"
    Vedhæft_2b = Dir & Cells(r, 10) & "KV.pdf"
    Vedhæft_3a = Dir & Cells(r, 16) & "KL.pdf"
    Vedhæft_3b = Dir & Cells(r, 16) & "KV.pdf"
   
    For r = 2 To 25 'data in rows 2-4
Rem Get the email address
        Email = Cells(r, 21)
       
        If Cells(r, 21) <> "" Then
            bygMail r
        End If
    Next r
End Sub
Private Sub bygMail(r)

        Email = Cells(r, 21)
'      Message subject Format(Cells(r, 2), "hh:mm:ss")
        Subj = "" & "" & Cells(r, 4) & ", " & Cells(r, 10) & "" & Cells(r, 16) & "" & Format(Now() + 1, "dddd dd mmmm yyyy") & "" & Format(Now(), "dddd mmmm yy hh:mm")
       
       

'      Compose the message
        If (Cells(r, 1)) <> "" Then
        Msg = Msg & "" & Format(Cells(r, 1), "hh:mm") & vbCrLf & vbCrLf
        End If
       
        If (Cells(r, 4)) = "A" Then
        Msg = Msg & "A" & vbCrLf
        ElseIf (Cells(r, 4)) = "B" Then
        Msg = Msg & "B" & vbCrLf
        ElseIf (Cells(r, 4)) = "C" Then
        Msg = Msg & "C" & vbCrLf
        ElseIf (Cells(r, 4)) > 0 Then
        Msg = Msg & "Tal" & vbCrLf
        .Attachments.Add Vedhæft_1a & Vedhæft_1b
        End If
       
        If (Cells(r, 10)) = "A" Then
        Msg = Msg & "A" & vbCrLf
        ElseIf (Cells(r, 10)) = "B" Then
        Msg = Msg & "B" & vbCrLf
        ElseIf (Cells(r, 10)) = "C" Then
        Msg = Msg & "C" & vbCrLf
        ElseIf (Cells(r, 10)) > 0 Then
        Msg = Msg & "Tal" & vbCrLf
        .Attachments.Add Vedhæft_2a & Vedhæft_2b
        End If
       
        If (Cells(r, 16)) = "A" Then
        Msg = Msg & "A" & vbCrLf
        ElseIf (Cells(r, 16)) = "B" Then
        Msg = Msg & "B" & vbCrLf
        ElseIf (Cells(r, 16)) = "C" Then
        Msg = Msg & "C" & vbCrLf
        ElseIf (Cells(r, 16)) > 0 Then
        Msg = Msg & "Tal" & vbCrLf
        .Attachments.Add Vedhæft_3a & Vedhæft_3b
        End If


'      Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
               
'      Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
'      Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
       
'      Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'      Wait two seconds before sending keystrokes
'        Application.Wait (Now + TimeValue("0:00:02"))
'        Application.SendKeys "%s"
       
   

   
End Sub