Office Email Merge with email options (Read receipt, delivery receipt, etc)

JOrzech,

I was originaly only planning to use the "built-in" email merge but I'll look up the VB one and try this, if it works I'll come back and "accept"

if anyone has an example, or knows where I could find a quick example of the vb one it would help

What if you ensure that the computer you run the mail merge on has settings in outlook so that all messages sent have a read/delivery receipt selected as default.. Do the messages that are created via the mail merge then honour this settings and have it set, or do they ignore the settings specified in outlook?
 

za_mkh,

Sadly it appears that no the mail merge does not do this, I'll continue to test and will continue to look for a vb script.

I've found the following code... but I just copied it as is - I apologize, but I currently do not have time to tweak it....possibly later today I can re-look at this but wanted to get you the code I found online :

 

Private Sub Send_Email_Click()
 
Dim sFile As String
Dim i As Integer
Dim itm As Object
Dim ID As String
Dim wd As Word.Application
Dim Doc As Word.Document
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim oReceipt As Outlook.Recipient
 
' check buletin selected for sending
 
If Nz(Me!sendEBS, "") = "" Then
    MsgBox "Please select a bulletin to send"
    Exit Sub
End If
 
 
'get email addresses record set
 
    Select Case Me!sTo
    
        Case Is = "Members"
            Set rs = CurrentDb.OpenRecordset("SELECT [EmailName] FROM [Contacts] WHERE [Contact_Type] = 'Member'", dbOpenSnapshot, dbSeeChanges)
        Case Is = "Prospects"
            Set rs = CurrentDb.OpenRecordset("SELECT [EmailName] FROM [Contacts] WHERE [Contact_Type] = 'Prospect'", dbOpenSnapshot, dbSeeChanges)
        Case Else
            MsgBox "Please select a recipient"
            Exit Sub
    End Select
    
'Are You Sure
If vbNo = MsgBox("Send [ " & Me!sendEBS & " ] To [ " & Me!sTo & " ], Are you sure?", vbYesNo) Then
   Exit Sub
End If
 
Msg = "Enter the subject to be used for each email message."    ' Set prompt.
 
tit = " Email Subject Input"    ' Set title.
 
' Display message, title
 
sSubject = InputBox(Msg, tit)
    
If Nz(sSubject, "") = "" Then
    MsgBox "You must supply an email subject"
    Set rs = Nothing
    Exit Sub
End If
    
sFile = EBS_DIR & Me!sendEBS
 
Set wd = CreateObject("Word.Application")
 
Set Doc = wd.Documents.Open(FileName:=sFile, ReadOnly:=True)
    Set itm = Doc.MailEnvelope.Item
    With itm
        .To = DEFAULT_EMAIL
        .Subject = sSubject
        .Save
        ID = .EntryID
    End With
 
'clear references
Doc.Close wdDoNotSaveChanges
wd.Quit False
 
Set itm = Nothing
Set Doc = Nothing
Set wd = Nothing
 
' start email and get saved item
    Set objApp = CreateObject("Outlook.Application")
 
    Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(ID)
    
    With l_Msg
    
        'Loop over recipients
        Do While Not rs.EOF
            Set oReceipt = .Recipients.Add(rs.Fields("EmailName"))
            oReceipt.Type = olBCC
            rs.MoveNext
        Loop
        
        rs.Close
        Set rs = Nothing
  
        ' add any attachments
        If (Me.editEBS.ListCount > 0) Then
            i = 0
 
           Do While i < Me.attEBS.ListCount
                .Attachments.Add (Me.attEBS.ItemData(i))
                i = i + 1
            Loop
 
        End If
        
        .Display
    End With
 
 
    'clear references
    
    Set oReceipt = Nothing
    Set l_Msg = Nothing
    Set objApp = Nothing
    
End Sub

Select allOpen in new window

I'll take a look at this right away, thanks JOrzech

That code seems to be part of a bigger application,

I'm going to award your first respoince with full points as it is the two flags one can set in VBA to make this happen.

Thanks very much PhilippeT.