Запускать Outlook Mail Body, используя VBA

Question

В сценариях VBA я пытаюсь написать вспомогательную функцию со следующей подписью

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

Тело электронной почты выглядит следующим образом:

Привет всем,

Пожалуйста, найдите следующую информацию.

TASK : taskName

СВЯЗАННАЯ ЗАДАЧА : RelatedTasks ()

ФАЙЛ : myFile

ЧЕЛОВЕК : myPer

В функции Sub шаблон слева от двоеточия всегда постоянен. И правая сторона будет меняться в зависимости от входных данных функции.

Для этого я читаю Template.htm, который содержит необходимую подпись.

Template.htm содержит:

Hello All,

Please find the following information.

TASK: {{mytask}}

RELATED TASK:{{myRelatedTasks}}

FILE : {{myFile}}

PERSON : {{myPerson}}

В коде VBA я заменяю все поля.

Проблема, с которой я сталкиваюсь, это {{mytask}} и {{связанные задачи}} также должны иметь ссылку HTML. Мне удалось добавить ссылку на mytask. Нажатие на mytask в почте приведет к переходу на соответствующую ссылку.

<a href = "www.something.com&amp;id ={{taskID}}>
{{mytask}}.....<a href = "www.xxx.com&amp;id={{}}>{{myRelatedTasks}}

но возникают проблемы при добавлении того же к Связанным задачам, так как это массив.

Мой код VBA:

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

А также, когда я присоединяюсь к связанным задачам, я хочу, чтобы они шли один за другим с отступом. Я попытался сделать это, указав "\ t" в качестве разделителя, но безуспешно.

Я хочу дать ссылки на мои связанные задачи, а также хочу, чтобы они аккуратно выровняли их. Спасибо.

Это то, что я могу напечатать в моей почтовой программе Outlook:

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

Для выравниваний: Вы можете поместить связанные задачи в таблицу или использовать вкладку (vbTab, а не "\t")

Для нескольких строк: было бы проще, если бы у вас был 2D-массив (например, r(0,0)="RelatedTaskName" и r(0,1)="RelatedTaskID") вместо разделения на основе двоеточия, но это выполнимо, и есть несколько различных способов пойти об этом.

Метод, который я собираюсь использовать здесь, состоит в том, чтобы создать всю вашу строку сразу, а затем использовать Replace, чтобы вывести готовый продукт: (используя Tab вместо Таблицы для отступов)

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 & "<a href = ""www.xxx.com&amp;id=" & taskID & """>" & taskName & "</a><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