Emailen en body hulp VBA EXCEL

[Jarno92]

Goedemiddag,

Ben een beginneling in Excel en vooral VBA maar ik heb het voor elkaar om het volgende te doen.

Mijn bereik als PDF maken en in mail versturen.

Echter nu heb ik 2 brandende vragen waar ik echt niet uit kom.

* Alle Email adressen die in het tabblad Email adressen staat toevoegen aan de mail in de BCC. Verschillende dingen al geprobeerd maar het lukt niet)
* De tekst in de email moet er zo uit komen te zien als in de excel als afbeelding staat. Dus netjes met spaties etc.

Het bestand heb ik bijgevoegd.

Hoop dat jullie mij kunnen helpen

 

[AD1957]

Met de tekst in de cellen H20 t/m H30

Sub pdf_verzenden_outlook()

    Dim Bestand As String
    Dim OutApp As Object
    Dim OutMail As Object
     
    Bestand = Environ("TEMP") & "\" & ActiveSheet.[A6] & " " & ActiveSheet.[ B1] & ".pdf"
    Range("B1:E42").ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=Bestand
    
   Dim strBCC As string
    ar = Sheets("Email adressen").Cells(1).CurrentRegion
    For i = 1 To UBound(ar)
        strBCC = strBCC & ar(i, 1) & ";"
    Next i
    
    If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .to = "Mijn eigen email adres"
        .CC = ""
        .BCC = strBCC
        .Subject = "Cel A1 en A2 van tablad verstuur blad"
        .Body = Range("H20").Value & vbCrLf & _
                Range("H21").Value & vbCrLf & _
                Range("H22").Value & vbCrLf & _
                Range("H23").Value & vbCrLf & _
                Range("H24").Value & vbCrLf & _
                Range("H25").Value & vbCrLf & _
                Range("H26").Value & vbCrLf & _
                Range("H27").Value & vbCrLf & _
                Range("H28").Value & vbCrLf & _
                Range("H29").Value & vbCrLf & _
                Range("H30").Value
        .Attachments.Add Bestand
        .Display '.Send
    End With
    
   

Kill Bestand
'
End Sub

 

[edmoor]

Of voor de BCC adressen:

BCC = Join(Application.Transpose(Sheets("Email adressen").Range("A1:A21")), ";")

 

[AD1957]

En voor als er meer email adressen bijkomen:

 i = Sheets("Email adressen").Range("A1").End(xlDown).Row
  .BCC = Join(Application.Transpose(Sheets("Email adressen").Range("A1:A" & i)), ";")

Of maak van de email adressen een echte tabel:

.BCC = Join(Application.Transpose(Sheets("Email adressen").Range("Tabel1[mailadressen]")), ";")

 

[snb]

Kan ook met VBA:

  With createobject("outlook.application").createitem(0)
    .to = "Mijn eigen email adres"
    .BCC =  join([transpose(A21:A30)],",")
    .Subject = "Voorbeeld"
    .Body = join([transpose(H21:H30)],vbcrlf)
    .Attachments.Add Bestand
    .Send
  End With

 

[Jarno92]

Super, ik ga er op deze manier wel uitkomen!

Bedankt