Email Links from Excel

Sub Mail_SheetsArray()

Sheets("offerte").Select
  Dim OutApp As Object
   Dim OutMail As Object
    Dim strbody As String
    Dim sendmailto As String
    Dim AddPicture As String
    
    
  


    
    sendmailto = Worksheets("offerte").Range("j10")
    
    strname0 = ""
    strname0 = strname0 & ActiveSheet.Range("a1")
    strname0 = strname0 & " - " & ActiveSheet.Range("a2")
    strname0 = strname0 & " - " & ActiveSheet.Range("a3")
   
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    AddPicture = "C:\Documents and Settings\Minne Feitsma\Mijn documenten\Mijn afbeeldingen\picture1.jpg"
 
      strbody = "Beste " & ActiveSheet.Range("J11") & ", " & vbNewLine & vbNewLine & _
               "Bedankt voor de offerte aanvraag " & vbNewLine & vbNewLine & _
               "oplage " & ActiveSheet.Range("B28") & " " & ActiveSheet.Range("B38") & vbNewLine & _
               ActiveSheet.Range("B20") & vbNewLine & _
               ActiveSheet.Range("B21") & vbNewLine & _
               ActiveSheet.Range("B22") & vbNewLine & _
               ActiveSheet.Range("B23") & vbNewLine & _
               vbNewLine & "Bedrukking " & ActiveSheet.Range("B30") & _
               vbNewLine & "Bedrukkings oppervlak" & " " & ActiveSheet.Range("B32") & "   " & ActiveSheet.Range("B33") & vbNewLine & _
               "Drukformaat " & ActiveSheet.Range("B36") & " cm" & vbNewLine & _
              "Offerte bedrag is exclusief BTW en Transport" & " " & ActiveSheet.Range("B40") & " euro" & vbNewLine & vbNewLine & _
               "Hieronder staan punten waar u rekening mee moet houden" & vbNewLine & _
              vbNewLine & ActiveSheet.Range("B49") & _
              vbNewLine & ActiveSheet.Range("B50") & _
              vbNewLine & ActiveSheet.Range("B51") & _
              vbNewLine & ActiveSheet.Range("B52") & _
              vbNewLine & ActiveSheet.Range("B53") & _
              vbNewLine & ActiveSheet.Range("B54") & _
              vbNewLine & ActiveSheet.Range("B55") & _
              vbNewLine & ActiveSheet.Range("B56") & _
              vbNewLine & ActiveSheet.Range("B57") & _
              vbNewLine & ActiveSheet.Range("B58") & _
              strname0 & vbNewLine & vbNewLine & _
              "Groeten van Minne Feitsma." & vbNewLine & _
              "tel : 0228-319566"
     

   
    On Error Resume Next
    With OutMail
        .To = sendmailto
        .CC = ""
        .BCC = ActiveSheet.Row("A1:A3")
        .Subject = "Offerte van GM Zeefdruk." & " Offertenummer " & ActiveSheet.Range("B16")
        .Body = strbody
        .Send   'or use .Display
        '.Display
    End With
    
     
     
     
    On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub