使用VBA触发Outlook邮件正文

时间:2018-05-01 15:12:56

标签: vba excel-vba outlook outlook-vba excel

在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

电子邮件正文如下:

大家好,

请查看以下信息。

任务:taskName

相关任务:RelatedTasks()

文件:myFile

PERSON :myPer

在Sub函数中,冒号左侧的模式始终是常量。右侧将根据函数的输入而改变。

为此,我正在阅读包含所需签名的Template.htm。

Template.htm包含:

Hello All,

Please find the following information.

TASK: {{mytask}}

RELATED TASK:{{myRelatedTasks}}

FILE : {{myFile}}

PERSON : {{myPerson}}

在VBA代码中,我正在替换所有字段。

我面临的问题是{{mytask}}和{{related tasks}}也应该有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

而且,当我加入相关任务时,我希望他们在缩进时来到另一个下面。我试着给它&#34; \ t&#34;作为分隔符没有成功。

我想引用我的相关任务,并希望它们整齐地对齐它们。感谢。

这是我能够在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

1 个答案:

答案 0 :(得分:0)

对齐:您可以将相关任务拖放到表格中,也可以使用标签(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