擴展我的Outlook VBA代碼以使用忙/閒和安排應用程序

Question

我有時候會在國際旅行，而當我這樣做時，我必須與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 

我想什麼做的是先檢查交易所的忙/閒爲所有這些人，然後讓我的程序發送一個邀請到他們的日曆和參考，在郵件上方。任何人都可以向我提供一些關於如何在Outlook OM中執行此操作的提示？謝謝！

Answer 1

對於忙/閒信息，請看Recipient.FreeBusy member - 您需要對結果進行一些解析。

日曆邀請，你只需創建類型olAppointmentItem的一個新項目，例如： 設置myItem = myOlApp.CreateItem（olAppointmentItem） 例here。