Bulk email vanuit Excel met bijlage en handtekening met afbeelding

[MUMSEL]

Goedemiddag,

Graag wil vanuit een Excel lijst met hierin Aan, CC, Onderwerp, Bericht en Pad naar bijlage vermeld een bulk email versturen. Inmiddels heb ik de signature met afbeelding in de mail kunnen toevoegen, maar er gebeuren dingen vanuit de macro die niet bedoeling zijn . Ben al een paar weken aan het stoeien, maar ik krijg het niet voor elkaar.

Sub Send_Email_with_Signature()

Dim Outlook_App As Object
Dim msg As Object
Dim sign As String

Dim sh As Worksheet
Dim i As Integer
Dim last_row As Integer


Set sh = ThisWorkbook.Sheets("Sheet1")

Set Outlook_App = CreateObject("Outlook.Application")
Set msg = Outlook_App.createitem(0)

msg.display

sign = msg.htmlbody

For i = 3 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
    With msg
        .To = sh.Range("A" & i).Value
        .CC = sh.Range("B" & i).Value
        .Subject = sh.Range("C" & i).Value
        .htmlbody = "Test" & sign
        .attachments.Add sh.Range("E" & i).Value
        
        If sh.Range("E" & i).Value <> "" Then
        
        End If
        
        .display
    End With
Next i

End Sub

Uitvoer van de macro in het testbestand (zonder juist gedefinieerd pad voor bijlage) geeft een email van regel 3 (onderwerp 2) zonder bijlage.
Uitvoer van de macor in het testbestand met een juist gedefinieerd pad voor bijlage geeft een email van regel 4 (onderwerp 3) met bijlage van Onderwerp 2 en 3 (C: Pad2 en C: Pad3).

Ik zou graag per regel een email naar de juiste afzender met de juiste bijlage en het onderwerp/tekst van de email in Excel gedefinieerd, op mijn beeldscherm zien, zodat ik deze kan checken en zelf (handmatig) kan verzenden.

Wie kan mij helpen om de VBA code te fine-tunen?

 

[VenA]

Weken aan het stoeien en dan een bestand plaatsen zonder code? Wat je precies wil is mij niet duidelijk maar de code kan wel wat eenvoudiger.

Sub VenA()
  ar = Sheets("Sheet1").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    With CreateObject("Outlook.Application").createitem(0)
      c00 = .htmlbody
      .to = ar(j, 1)
      .cc = ar(j, 2)
      .Subject = ar(j, 3)
      .htmlbody = c00
      If ar(j, 5) <> "" Then
        If Dir(ar(j, 5)) <> "" Then .attachments.Add ar(j, 5)
      End If
      .display
    End With
  Next j
End Sub

 

[MUMSEL]

VenA, bedankt voor je reactie. Wilde het bestand aangemaakt in mijn werkomgeving, vanuit mijn prive omgeving aanmaken en uploaden. In de haast is de code verloren gegaan, excuus hiervoor.

Je code maakt inderdaad 3 mailtjes aan met juiste ontvanger, onderwerp en bijlage, super!

De 'body' (tekst in email) en de handtekening (.htmlbody) worden echter niet weergegeven in mail (In Outlook staat mijn signature ingesteld om in nieuwe berichten weer te geven). Dit is wel gewenst. Heb

.body = ar(j, 4)

toegevoegd (zie onderstaand), maar dit geeft niet het gewenste resultaat voor de tekst in de mail.

Hopelijk heeft iemand hiervoor nog een oplossing. Tot zover al heel erg bedankt!

Sub VenA()
  ar = Sheets("Sheet1").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    With CreateObject("Outlook.Application").createitem(0)
      c00 = .htmlbody
      .to = ar(j, 1)
      .cc = ar(j, 2)
      .Subject = ar(j, 3)
      .body = ar(j, 4)
      .htmlbody = c00
      If ar(j, 5) <> "" Then
        If Dir(ar(j, 5)) <> "" Then .attachments.Add ar(j, 5)
      End If
      .display
    End With
  Next j
End Sub

 

[VenA]

Inmiddels heb ik de signature met afbeelding in de mail kunnen toevoegen

Dan moet je maar even kijken hoe je dat gedaan hebt.

 

[edmoor]

Voor de handtekening staat de .Display op de verkeerde plek:

Sub VenA()
  ar = Sheets("Sheet1").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    With CreateObject("Outlook.Application").createitem(0)
      [COLOR="#FF0000"].Display[/COLOR]
      c00 = .htmlbody
      .to = ar(j, 1)
      .cc = ar(j, 2)
      .Subject = ar(j, 3)
      .htmlbody = c00
      If ar(j, 5) <> "" Then
        If Dir(ar(j, 5)) <> "" Then .attachments.Add ar(j, 5)
      End If
    End With
  Next j
End Sub

 

[VenA]

Iets te hard gesnoeid blijkbaar.

 

[edmoor]

Te enthousiast

Daarnaast zou ik ieder bericht nog afsluiten met een .Close olSave
Dan staan al die mails niet op het beeldscherm maar in de Drafts folder in Outlook.

 

[MUMSEL]

VenA en edmoor, bedankt voor jullie oplossing! Ik heb een extra fijn weekend nu :thumb:

 

[edmoor]

Nog een kleine aanpassing in #7 gedaan.