The principles involved are similar to those described in http://www.gmayor.com/mail_merge_charts.htm. You need two ranges (which I have added to your worksheet) and I have changed the lines so that you can see what is happening in real time. I would also use the Inspector to edit the message directly. The only downside of that is that it must display the messages before sending them. You only actually need one of the macros, you can conditionally add the .Send line as required (see below).
Option Explicit
Sub Preview()
SendEmail False
lbl_Exit:
Exit Sub
End Sub
Sub NoPreview()
SendEmail True
lbl_Exit:
Exit Sub
End Sub
Sub SendEmail(Optional bNoPreview As Boolean)
Dim iRec As Long
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim wdRng As Object
Dim rng As Range
Dim StrBody As String
Dim StrBody1 As String
Dim i As Long
Dim Subj As String
Dim FilePath As String
Dim EmailTo As String
Dim CCto As String
With Range("MergeData")
For i = 1 To .Rows.Count
Range("MergeRecord") = i - 1
Set rng = Nothing
Subj = .Cells(i, "A").Value
FilePath = .Cells(i, "B").Value
EmailTo = .Cells(i, "C").Value
CCto = .Cells(i, "D").Value
MsgBox Subj
Application.DisplayAlerts = False
Set rng = Sheets("Sheet2").Range("A1:E2").SpecialCells(xlCellTypeVisible)
rng.Copy
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
StrBody = "Dear Sir," & vbCr & vbCr & _
"Please be advised that we have given entry outstanding in our books." & vbCr & vbCr
StrBody1 = vbCr & vbCr & "We have attached copy document for your reference. Please could you have a look and provide your agreement and settlement date." & vbCr & vbCr & _
"Regards," & vbCr & vbCr
On Error Resume Next
With OutMail
.To = EmailTo
.CC = CCto
.BCC = ""
.Subject = Subj
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set wdRng = wdDoc.Range(0, 0)
wdRng.Text = StrBody
wdRng.collapse 0
wdRng.Paste
wdRng.collapse 0
wdRng.Text = StrBody1
.Attachments.Add FilePath
.Display
If bNoPreview Then
.Send
End If
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Sheets("Email_Sheet").Cells(1, "A").Value = "Outlook sent Time, Dynamic msg preview count = " & i + 1
Next i
End With
Cleanup:
Set OutApp = Nothing
Set OutMail = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set wdRng = Nothing
Set rng = Nothing
lbl_Exit:
Exit Sub
End Sub
How to add table in the outlook via excel.
Reply With Quote
Originally Posted by westconn1
what are we doing here and why we have "Mergedata" in the "New Manager" field in excel. I have attached the updated macro with the mail. Please let me know how we can set the range dyanamic and the output is as per our expectation. We are going with the file you have provided me yesterday.
