自動創建Outlook約會

Question

我有一個跟蹤到期日期的電子表格（excel 2003），我想知道是否有辦法讓這些截止日期在outlook中創建約會（提醒）。到期日期在一個字段中，實體的名稱位於電子表格的另一列中。理想情況下，我希望展望（2003年）拿起日期（顯然）和實體的名稱。

預先感謝任何幫助

Answer 1

您可以使用VBA宏來創建出來的樣子約會。 以下2個鏈接將幫助您開始。

1. Creating outlook appointment using VBA
2. Outlookcode

Answer 2

你可以通過會議邀請做到這一點。他們不會被自動接受，但他們會在那裏。會議邀請只是包含標題中特殊內容的電子郵件。

Answer 3

以下是一些示例代碼。

Sub CreateCalEntry(LeadDate As Date, DueDate As Date, _ 
      Subject As String, Location As String, _ 
      Body As String, _ 
      Optional AddToShared As Boolean = True) 

'Lead date = expect notify from data' 
'Due date - expect event due date' 
'Add to shared - add item to shared calendar, ' 
'hard coded as 'Shared Calendar'' 

Const olApItem = 1 

Dim apOL As Object 'Outlook.Application ' 
Dim oItem As Object 'Outlook.AppointmentItem ' 
Dim objFolder As Object 'MAPI Folder ' 

    Set apOL = CreateObject("Outlook.Application") 
    Set objFolder = GetFolder(_ 
     "Public Folders/All Public Folders/Shared Calender") 
    Set oItem = apOL.CreateItem(olApItem) 

    With oItem 
     .Subject = Subject 
     .Location = Location 
     .Body = Body 

     If IsDate(LeadDate) Then 
      .Start = DueDate 
     Else 
      .Start = DueDate 
     End If 

     If AddToShared = True Then 
      .Move objFolder 
     End If 

     .Display 
    End With 

    Set oItem = Nothing 
    Set apOL = Nothing 

End Sub 

Public Function GetFolder(strFolderPath As String) As Object 
' strFolderPath needs to be something like ' 
' "Public Folders\All Public Folders\Company\Sales" or ' 
' "Personal Folders\Inbox\My Folder" ' 
'This code is from: 
'http://www.outlookcode.com/d/code/getfolder.htm ' 

Dim apOL As Object 'Outlook.Application ' 
Dim objNS As Object 'Outlook.NameSpace ' 
Dim colFolders As Object 'Outlook.Folders ' 
Dim objFolder As Object 'Outlook.MAPIFolder ' 
Dim arrFolders() As String 
Dim I As Long 

    strFolderPath = Replace(strFolderPath, "/", "\") 
    arrFolders() = Split(strFolderPath, "\") 

    Set apOL = CreateObject("Outlook.Application") 
    Set objNS = apOL.GetNamespace("MAPI") 

    On Error Resume Next 

    Set objFolder = objNS.Folders.Item(arrFolders(0)) 

    If Not objFolder Is Nothing Then 
     For I = 1 To UBound(arrFolders) 
      Set colFolders = objFolder.Folders 
      Set objFolder = Nothing 
      Set objFolder = colFolders.Item(arrFolders(I)) 

      If objFolder Is Nothing Then 
       Exit For 
      End If 
     Next 
    End If 

    Set GetFolder = objFolder 
    Set colFolders = Nothing 
    Set objNS = Nothing 
    Set apOL = Nothing 

End Function 

來源：http://wiki.lessthandot.com/index.php/Create_Outlook_Appointment%2C_Shared_Folder