Raghava@rock
Member
Hi Team below is the code i have in an excel template to replace text on body of the mail with some values.
However while i run code only two texts are getting replaced can you please help.
>>> use code - tags <<<
However while i run code only two texts are getting replaced can you please help.
>>> use code - tags <<<
Code:
Sub DistributeReports()
If MsgBox("Please confirm if the default signature for new mails have been disabled" & vbLf & "Continue?", vbYesNo, "Error!") = vbNo Then Exit Sub
On Error Resume Next
Dim myolApp As Object
Dim myItem As Object
Dim myAttachments As Object
Dim TemplatePath As String
Const TemplateName As String = "QRT Email TEMPLATE.oft"
TemplatePath = Environ("USERPROFILE") & "\AppData\Roaming\Microsoft\Templates\QRT Templates\" & TemplateName
Set myolApp = CreateObject("Outlook.Application")
Dim Currentfile As String
Dim Row1 As Integer
Dim response As String
Dim PPMD_Name As String
Dim WBS_PRName As String
Dim WE_ED As String
Dim WBS_N As String
Dim WBS_NAM As String
Dim body, body1, body2, body3, body4 As String
Row1 = 2
Currentfile = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
While Not (Cells(Row1, 1) = "!EOF")
On Error Resume Next
Set myItem = myolApp.CreateItemFromTemplate(TemplatePath)
Set myAttachments = myItem.Attachments
' >>> as written in Forum Rules - do not give Your email-address
myItem.SentOnBehalfOfName = "r a g h a v a s h r m @ g m a i l . c o m"
' <<< as written in Forum Rules - do not give Your email-address
myItem.To = Cells(Row1, 2)
myItem.CC = Cells(Row1, 3)
myItem.Subject = Cells(Row1, 4)
PPMD_Name = Cells(Row1, 1).Value
WBS_PRName = Cells(Row1, 9).Value
WE_ED = Cells(Row1, 18).Value
WBS_N = Cells(Row1, 7).Value
WBS_NAM = Cells(Row1, 8).Value
body = myItem.HTMLbody
body = Replace(body, "[PPMD Name]", PPMD_Name)
body1 = myItem.HTMLbody
body1 = Replace(body, "[Dataset1]", WBS_PRName)
body2 = myItem.HTMLbody
body2 = Replace(body, "[WBSNAM]", WBS_NAM)
myItem.HTMLbody = body
myItem.HTMLbody = body1
myItem.HTMLbody = body2
myItem.Display
myItem.Send
If Err Then
Exit Sub
End If
Row1 = Row1 + 1
Wend
End Sub
Last edited by a moderator: