扩展我的Outlook VBA代码以使用忙/闲和安排appts

时间:2010-09-07 23:34:22

标签: outlook outlook-vba

我有时会去国际旅行,当我这样做时,我必须会见5到10名内部同事。到目前为止,我所做的是使用以下代码发送介绍,看看他们何时可以自由见面。我把它们的名字和姓氏都放在Excel中,以及我之前是否见过它们。

Sub CreateInvite(lngDuration As Long, strInviteBody As String, strLocation As String, strSubject As String, strRec As String)
Dim olApp As Outlook.Application
Dim olMeetingInvite As AppointmentItem
Set olApp = CreateObject("outlook.application")
Set olMeetingInvite = olApp.CreateItem(olAppointmentItem)
With olMeetingInvite
.Body = strInviteBody
.Display
.Recipients.Add strRec
.Recipients.ResolveAll
.Subject = strSubject
.Location = strLocation
.Duration = lngDuration
End With
End Sub
Sub RunInviteCreator()
Dim strRec As String
Dim strRecFirstName As String
Dim strLoc As String
Dim xlApp As Excel.Application
Set xlApp = CreateObject("excel.application")
Dim xlWS As Excel.Workbook
Set xlWS = xlApp.Workbooks.Open("C:\Invitees.xls")
Dim xlSheet As Excel.Worksheet
Set xlSheet = xlWS.ActiveSheet
Dim strSubject As String
Dim strLocation As String
Dim i As Integer
Dim iMeetingLength As Integer
Dim strHour As String
Dim strMeetingLength As String
Dim strInviteBody1 As String
Dim strInviteBody2 As String
Dim strInviteBody As String
Dim strKnown As String

For i = 2 To 21
strRecFirstName = xlSheet.Cells(i, 1)
strRec = xlSheet.Cells(i, 3)
strSubject = xlSheet.Cells(i, 6)
strLocation = xlSheet.Cells(i, 8) & "/" & xlSheet.Cells(i, 9)
iMeetingLength = xlSheet.Cells(i, 7)
If iMeetingLength > 60 Then strHour = "hours" Else strHour = "hour"
strMeetingLength = CStr(iMeetingLength / 60)
strInviteBody1 = "Dear " & strRecFirstName & "," & vbCrLf

strKnown = "Allow me to introduce myself. I am Mahin from HQ in Boise." & vbCrLf & vbCrLf

strInviteBody2 = _
"I will be in " & area & "from May 17 to May 23 and would really like to meet with you, learn about your business and see how we can cooperate to drive initiatives in FY10." & vbCrLf & vbCrLf & _
"I’ve checked your calendar and this looks like a good time. If not, however, please feel free to propose a new time. The best time would be Friday, which I am leaving open to accommodate calendar reschedules. Also, I have booked this for " & strMeetingLength & " " & strHour & ". If you feel the meeting needs to be longer or shorter, please let me know." & vbCrLf & vbCrLf & _
"I really look forward to meeting you and working with you." & vbCrLf & vbCrLf & _
"Best Regards," & vbCrLf & vbCrLf & _
"Mahin" 

If xlSheet.Cells(i, 10) = "Yes" Then
strInviteBody = strInviteBody1 & strInviteBody2
Else
strInviteBody = strInviteBody1 & strKnown & strInviteBody2
End If

CreateInvite CLng(iMeetingLength), strInviteBody, strLocation, strSubject, strRec
Next i

End Sub

我想做的是首先检查所有这些人的Exchange忙/闲,然后让我的程序向他们的日历发送邀请并在上面的邮件中引用。任何人都可以向我提供有关如何在Outlook OM中执行此操作的一些指示? THX!

1 个答案:

答案 0 :(得分:2)

对于忙/闲信息,请查看Recipient.FreeBusy member - 您需要对结果进行一些解析。

对于日历邀请,您只需创建一个类型为olAppointmentItem的新项目,例如: 设置myItem = myOlApp.CreateItem(olAppointmentItem) 示例here