Outlook reply to in mail mergre

[mstopel]

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!




'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

[gmayor]

You need the correct syntax i.e.
.ReplyRecipients.Add ReplyToTeacherswhere ReplyToTeachers is an e-mail address.

[mstopel]

You need the correct syntax i.e.
.ReplyRecipients.Add ReplyToTeacherswhere 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

[mstopel]

I have updated code to below, still no luck.


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

[gmayor]

It is difficult to see how


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

'.Datafields' is not related to OutlookMail.

[mstopel]

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.


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

[gmayor]

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).



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

[mstopel]

Absolute legend, thank you!

[gmayor]

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.