Trigger Outlook Mail Body using VBA - excel

Question

In VBA scripting ,I am trying to write a Sub Function which has the following signature
Sub(taskName As String , myGroup As String, myFile As String ,myPer As String, RelatedTasks() As String )
Dim olApp As Outlook.Application
Dim m As Outlook.MailItem
Set olApp = New Outlook.Application
Set m = olApp.CreateItem(olMailItem)
With m
.display
.To = "somewhere#someplace.com"
.Subject = "Test Events"
.HTMLBody/.body = ...
End Sub
Email Body is as follows:
Hello All,
Please find the following information.
TASK: taskName
RELATED TASK:RelatedTasks()
FILE : myFile
PERSON : myPer
In the Sub function , the pattern to the left of colon is always constant.And the right side will change based on the inputs to the function.
For that I am reading the Template.htm which contains the required signature.
Template.htm contains:
Hello All,
Please find the following information.
TASK: {{mytask}}
RELATED TASK:{{myRelatedTasks}}
FILE : {{myFile}}
PERSON : {{myPerson}}
In VBA code,I am replacing all the fields.
The issue that I am facing is {{mytask}} and {{related tasks}} also should have a HTML reference. I have succeeded in adding the link to mytask .Clicking on the mytask in the mail will jump to the respective weblink.
<a href = "www.something.com&id ={{taskID}}>
{{mytask}}.....<a href = "www.xxx.com&id={{}}>{{myRelatedTasks}}
but having trouble in adding the same to Related tasks since it is an array.
My VBA code :
Option Explicit
Sub CreateNewMail()
Dim olApp As Outlook.Application
Dim m As Outlook.MailItem
Dim sigPath As String, sigText As String
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Dim t As String
Dim r(5) As Variant
t = "233444:dshfjhdjfdhjfhjdhfjdhfjd"
r(0) = "122343:dsjdhfjhfjdh"
r(1) = "323243:jfjfghfjhjddj"
r(2) = "834783:gffghjkjkgjkj"
Set olApp = New Outlook.Application
Set m = olApp.CreateItem(olMailItem)
sigPath = "C:\Users\Pavan-Kumar\Desktop\vbs\TestEvents.htm"
Set fso = New Scripting.FileSystemObject
Set ts = fso.OpenTextFile(sigPath)
sigText = ts.ReadAll
ts.Close
Set fso = Nothing
sigText = Replace(sigText, "{{mytask}}", t)
sigText = Replace(sigText, "{{myRelatedTasks}}", Join(r, "<br>"))
With m
.display
.To = "somewhere#someplace.com"
.Subject = "Test Events"
.HTMLBody = sigText
End With
End Sub
And also when I am joining the related tasks , I want them to come one below another with indentation. I tried it with giving "\t" as the delimiter with no success.
I want to give references to my Related tasks and also want them to neatly align them. Thanks.
This is what I am able to print in my outlook mail:
Hello All,
Please find the following information.
TASK: 233444:dshfjhdjfdhjfhjdhfjdhfjd
RELATED TASK:122343:dsjdhfjhfjdh
"\t"323243:jfjfghfjhjddj
"\t"834783:gffghjkjkgjkj
"\t"
"\t"
"\t"
FILE : TImers
PERSON : Charvaka

Answer 1

For the Alignments: You can either drop the Related Tasks into a Table, or you can use a Tab (vbTab, not "\t")
For the multiple-rows: This would be simpler if you had a 2D Array (e.g. r(0,0)="RelatedTaskName" and r(0,1)="RelatedTaskID") instead of splitting it based on a Colon, but it's doable, and there are several different ways to go about it.
The method that I am going to use here is to build all of your string at once, then use Replace to dump the finished product: (using Tab instead of a Table for the indents)
Dim taskID As String, taskName As String, lTaskNum As Long, TaskList As String
TaskList = "" 'Start with an empty list
For lTaskNum = LBound(r) To UBound(r)
If Len(TaskList) > 0 Then TaskList = TaskList & vbTab 'We are using Tab instead of a table here
taskName= r(lTaskNum) 'Grab element from the array
taskID = Left(taskName, InStr(taskName, ":") - 1) 'Just the number
taskName = Replace(taskName, taskID & ":", "",count:=1) 'Just the Link text
TaskList = TaskList & "" & taskName & "<br />" 'Add the task to the stack
Next lTaskNum
'If Len(TaskList) < 1 Then TaskList = "No Related Tasks" 'Optional bonus!
sigText = Replace(sigText, "{{myRelatedTasks}}", TaskList) 'Push the finished list into the email