Outlook reply to in mail mergre

Hi all,

I am trying to set the reply to address based on a value in the mailmerge - I have sucesfully done this for the address but cant get the .replyrecipient to work.

I have attached the extract from the code that has the email properties. They all work except for the reply to.

Any feedback appreicated.

The bigger picture of the macro is that individual emails are sent with their unique PDF attached, I jsut want the Reply to send to the teacher as i send the emails on behalf of many other people.

THanks!

Code:

---

     
      'Create an Outlook object and new mail message
       
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
       
    'Display email and specify To, Subject, etc
    With OutlookMail
       
    EmailTo = .DataFields("StudentNumber")
    ReplyToTeachers = .DataFields("Teacher")
   
 
        .Display
        .To = EmailTo
        .Subject = EmailSubject
        .Attachments.Add PDFUpload
        .ReplyRecipients = ReplyToTeachers
       
       
        If DisplayEmail = False Then
           
            .send
           
            Else
           
            '.send
           
        End If
       
   
      End With

---

You need the correct syntax i.e.

Code:

---

.ReplyRecipients.Add ReplyToTeachers

---

where ReplyToTeachers is an e-mail address.

Quote:

---

Originally Posted by gmayor

You need the correct syntax i.e.

Code:

---

.ReplyRecipients.Add ReplyToTeachers

---

where ReplyToTeachers is an e-mail address.

---

I'll change it tomorrow, but pretty sure I had tried that,

Correct in me saying the
= Is for the entry fields (as used in emailto and subject)
.add is used for a setting/file?

Is there any other reason this wouldn't work?

Cheers

I have updated code to below, still no luck.

Code:

---

      With ActiveDocument        'Add the name to the footer
        '.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
        '.SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        ' and/or:
        .SaveAs FileName:=StrFolder & PDFFile & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
       
           
        .Close SaveChanges:=False
       
        PDFUpload = StrFolder & PDFFile & ".pdf"
       
      End With
     
     
      'Create an Outlook object and new mail message
       
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
       
    'Display email and specify To, Subject, etc
    With OutlookMail
       
    EmailTo = .DataFields("StudentNumber")
    ReplyToTeachers = .DataFields("Teacher")
   
 
        .Display
        .To = EmailTo
        .Subject = EmailSubject
        .Attachments.Add PDFUpload
        .ReplyRecipients.Add ReplyToTeachers
       
       
        If DisplayEmail = False Then
           
            .send
           
            Else
           
            '.send
           
        End If
       
   
      End With

---

It is difficult to see how

Code:

---

With OutlookMail
    EmailTo = .DataFields("StudentNumber")
    ReplyToTeachers = .DataFields("Teacher")

---

could work.

'.Datafields' is not related to OutlookMail.

Here is the whole code. THE datafields from the mailmerge code works fine for the EmailTo field, just not ReplyRecipients

The code is a merge of 2 macros I have used in the past, but seems to work ok, except for this function.

Code:

---

Sub PDF_Save_and_Email_FINAL()

Application.ScreenUpdating = False
Dim StrFolder As String, DocName As String, PDFFile As String, MainDoc As Document, i As Long, j As Long, EmailTo As String, EmailSubject As String, PDFUpload As String










Const StrNoChr As String = """*./\:?|"
Set MainDoc = ActiveDocument


With MainDoc
  StrFolder = .Path & "\"
  DocName = InputBox("DocumentName")
  EmailSubject = DocName
   
   
  With .MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
   
    On Error Resume Next
    For i = 1 To .DataSource.RecordCount
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("LastName")) = "" Then Exit For
        'below line '
       
        'StrFolder = .DataFields("Folder") & "\"
        PDFFile = .DataFields("FirstName") & " " & .DataFields("LastName") & " - " & DocName
        EmailTo = .DataFields("StudentNumber")
       
       
      End With
      .Execute Pause:=False
      If Err.Number = 5631 Then
        Err.Clear
        GoTo NextRecord
      End If
      For j = 1 To Len(StrNoChr)
        PDFFile = Replace(PDFFile, Mid(StrNoChr, j, 1), "_")
      Next
      PDFFile = Trim(PDFFile)
      With ActiveDocument
        'Add the name to the footer
        '.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
        '.SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        ' and/or:
        .SaveAs FileName:=StrFolder & PDFFile & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
       
           
        .Close SaveChanges:=False
       
        PDFUpload = StrFolder & PDFFile & ".pdf"
       
      End With
     
     
      'Create an Outlook object and new mail message
       
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
       
    'Display email and specify To, Subject, etc
    With OutlookMail
       
    EmailTo = .DataFields("StudentNumber")
    ReplyToTeachers = .DataFields("Teacher")
   
 
        .Display
        .To = EmailTo
        .Subject = EmailSubject
        .Attachments.Add PDFUpload
        .ReplyRecipients.Add ReplyToTeachers
       
       
        If DisplayEmail = False Then
           
            .send
           
            Else
           
            '.send
           
        End If
       
   
      End With
     
     
NextRecord:
    Next i
  End With
End With
Application.ScreenUpdating = True




End Sub

---

The issue remains basically that I pointed out, but as you have posted the code, I have modified it so that it does work (provided you download the code from the link and put it in a separate module in your project).

Code:

---

Option Explicit

Sub PDF_Save_and_Email_FINAL()

'Use the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to start Outlook or you are likely to find that your messages simply disappear
'Code modified to call that function
'Graham Mayor - https://www.gmayor.com - Last updated - 15 May 2020

Dim OlApp As Object
Dim OutlookMail As Object, olInsp As Object
Dim wdDoc As Document
Dim oRng As Range
Dim StrFolder As String, DocName As String, PDFFile As String
Dim MainDoc As Document
Dim i As Long, j As Long
Dim EmailTo As String, EmailSubject As String, PDFUpload As String
Dim ReplyToTeachers As String, strSalutation As String
Const StrNoChr As String = """*./\:?|"

    Set MainDoc = ActiveDocument
    MainDoc.Save

    Application.ScreenUpdating = False

    With MainDoc
        StrFolder = .Path & "\"
        DocName = InputBox("DocumentName")
        EmailSubject = DocName

        With .MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True

            'start outlook before the loop
            Set OlApp = OutlookApp()

            On Error Resume Next

            For i = 1 To .DataSource.RecordCount
                With .DataSource
                    .FirstRecord = i
                    .LastRecord = i
                    .ActiveRecord = i
                    If Trim(.DataFields("LastName")) = "" Then Exit For
                    'below line '

                    'set the variable values from the data BEFORE creating the messages

                    PDFFile = .DataFields("FirstName") & " " & .DataFields("LastName") & " - " & DocName
                    EmailTo = .DataFields("StudentNumber")
                    ReplyToTeachers = .DataFields("Teacher")
                    strSalutation = .DataFields("FirstName")

                    MainDoc.MailMerge.Execute Pause:=False
                    If Err.Number = 5631 Then
                        Err.Clear
                        GoTo NextRecord
                    End If
                    For j = 1 To Len(StrNoChr)
                        PDFFile = Replace(PDFFile, Mid(StrNoChr, j, 1), "_")
                    Next j
                    PDFFile = Trim(PDFFile)
                    With ActiveDocument
                        'Add the name to the footer
                        '.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
                        '.SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
                        ' and/or:
                        .SaveAs FileName:=StrFolder & PDFFile & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
                        .Close SaveChanges:=False
                        PDFUpload = StrFolder & PDFFile & ".pdf"
                    End With


                    'Create a new mail message

                    Set OutlookMail = OlApp.CreateItem(0)

                    'Display email and specify To, Subject, etc
                    With OutlookMail
                        .BodyFormat = 2
                        .Display
                        .To = EmailTo
                        .Subject = EmailSubject
                        .Attachments.Add PDFUpload
                        .ReplyRecipients.Add ReplyToTeachers
                        Set olInsp = .GetInspector
                        Set wdDoc = olInsp.WordEditor
                        Set oRng = wdDoc.Range
                        oRng.Collapse 1
                        oRng.Text = "Hi " & strSalutation & vbCr & vbCr & _
                                    "Please find attached your document:- '" & PDFFile & ".pdf'"
                        'default signature for the sending account will be retained

                        .send
                    End With
                End With
NextRecord:
            Next i

        End With
    End With
    Application.ScreenUpdating = True
    Set OlApp = Nothing
    Set OutlookMail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set MainDoc = Nothing
End Sub

---

Absolute legend, thank you!

You may be interested in https://www.gmayor.com/email_merge_addin.html which was loosely based on my code in this thread with some useful additions.