Huan-Lin 學習筆記 on DotBlogs

以下程式碼可以在 Outlook 中建立一個約會：

using Outlook = Microsoft.Office.Interop.Outlook;
......

namespace AppointmentDemo
{
    public partial class Form1 : Form
    {
        Outlook.Application m_Outlook = new Outlook.Application();

        private void btnCreateAppointment_Click(object sender, EventArgs e)
        {
            Outlook.NameSpace ns;
            Outlook.MAPIFolder contactsFolder;
            Outlook.AppointmentItem apptItem;

            ns = m_Outlook.GetNamespace("mapi");
            contactsFolder = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts);

            // Create appointment
            apptItem = (Outlook.AppointmentItem) m_Outlook.CreateItem(Outlook.OlItemType.olAppointmentItem);

            apptItem.Subject = "與達文西的約會";
            apptItem.Location = "羅浮宮";
            apptItem.AllDayEvent = true;
            apptItem.Start = DateTime.Now.AddHours(1);
            apptItem.End = DateTime.Now.AddHours(2);

            apptItem.Save();

            MessageBox.Show("新增約會完成!");
        }
    }
}

以下 VBA 範例取自 http://www.outlookcode.com/codedetail.aspx?id=788），可以從 Excel 檔案中匯入約會項目：

Sub ImportAppointments()
    Dim exlApp As Excel.Application
    Dim exlWkb As Workbook
    Dim exlSht As Worksheet
    Dim rng As Range
    
    Dim itmAppt As Outlook.AppointmentItem
    Dim aptPtrn As Outlook.RecurrencePattern
    
    Dim fso As FileSystemObject
    Dim fl As File
    
    Set exlApp = New Excel.Application
    
    strFilepath = exlApp.GetOpenFilename
    If strFilepath = False Then
        exlApp.Quit
        Set exlApp = Nothing
        Exit Sub
    End If
     
    Set exlSht = Excel.Application.Workbooks.Open(strFilepath).Worksheets(1)
    Dim iRow As Integer
    Dim iCol As Integer
    
    Dim tmpItm As Outlook.Link
    Dim mpiFolder As MAPIFolder
    Dim oNs As NameSpace
    
    Set oNs = Outlook.GetNamespace("MAPI")
    
    Set mpiFolder = oNs.GetDefaultFolder(olFolderContacts)
    
    iRow = 2
    iCol = 1
    
    While exlSht.Cells(iRow, 1) <> ""
        Dim cnct As ContactItem
        Set itmAppt = Outlook.CreateItem(olAppointmentItem)
        itmAppt.Subject = exlSht.Cells(iRow, 1)
        Set cnct = mpiFolder.Items.Find("[FullName] = " & exlSht.Cells(iRow, 2))
        If cnct Is Nothing Then
            Set cnct = Outlook.CreateItem(olContactItem)
            cnct.FullName = exlSht.Cells(iRow, 2)
            cnct.Save
        End If
        itmAppt.Categories = exlSht.Cells(iRow, 3)
        itmAppt.Start = exlSht.Cells(iRow, 4)
        itmAppt.AllDayEvent = True
        
        itmAppt.Links.Add cnct
        Set aptPtrn = itmAppt.GetRecurrencePattern
        aptPtrn.StartTime = exlSht.Cells(iRow, 5)
        aptPtrn.EndTime = exlSht.Cells(iRow, 6)
        aptPtrn.RecurrenceType = olRecursYearly
        aptPtrn.NoEndDate = True
        If aptPtrn.Duration > 1440 Then aptPtrn.Duration = aptPtrn.Duration - 1440
        Select Case exlSht.Cells(iRow, 7)
        Case "No Reminder"
            itmAppt.ReminderSet = False
        Case "0 minutes"
            itmAppt.ReminderSet = True
            itmAppt.ReminderMinutesBeforeStart = 0
        Case "1 day"
            itmAppt.ReminderSet = True
            itmAppt.ReminderMinutesBeforeStart = 1440
        Case "2 days"
            itmAppt.ReminderSet = True
            itmAppt.ReminderMinutesBeforeStart = 2880
        Case "1 week"
            itmAppt.ReminderSet = True
            itmAppt.ReminderMinutesBeforeStart = 10080
        End Select
        itmAppt.Save
        iRow = iRow + 1
    Wend
    Excel.Application.Workbooks.Close
    exlApp.Quit
    Set exlApp = Nothing
End Sub