凯利（Kelly）有一个工作表，其中有一个日期表，用作将广告放入本地黄页的截止日期。她想将这些日期导入Outlook http://calendarcorner.net/ [日历]

具有72小时提醒功能，但某些日期会不断更改为数字。

凯利（Kelly）想知道如何根据需要将Excel日期添加到Outlook中。

使用Outlook比普通的Excel宏“级别更高”，因为您不仅需要了解如何访问宏中的Excel数据，还需要了解如何操作Outlook数据。在不确切知道从工作表传输到Outlook约会所需的数据的情况下，我们来看一个简短的场景。

假设您有一个包含一系列行的工作表，每个行代表您要创建的单个约会。每个约会包含从左到右的七列信息，如下所示：

主题。*描述事件/约会的文本（例如，“黄页提醒”）

位置。*描述事件位置的文本，例如会议室或电话会议号码（这是可选的）

开始日期/时间。*使用标准Excel日期格式输入事件应开始的日期和时间（您可以按照自己喜欢的方式显示）

持续时间。整数，表示约会“忙碌状态”的分钟数。代表可选值的整数，指示时间应显示为空闲（0），暂定（1），忙碌（2）还是不在办公室（3）

提醒时间。*整数，表示要弹出提醒的约会之前的分钟数（如4320，这是3天的分钟数）

正文。*描述您可能要在约会正文中放置的任何细节的文本

|有了这些数据后，您可以使用宏在所有行中循环（从第二行开始，假设第一行具有标题）

并为每一行创建一个约会。

Sub AddAppointments()

' Create the Outlook session     Set myOutlook = CreateObject("Outlook.Application")



' Start at row 2     r = 2

Do Until Trim(Cells(r, 1).Value) = ""

' Create the AppointmentItem          Set myApt = myOutlook.createitem(1)

' Set the appointment properties         myApt.Subject = Cells(r, 1).Value         myApt.Location = Cells(r, 2).Value         myApt.Start = Cells(r, 3).Value         myApt.Duration = Cells(r, 4).Value         ' If Busy Status is not specified, default to 2 (Busy)

If Trim(Cells(r, 5).Value) = "" Then             myApt.BusyStatus = 2         Else             myApt.BusyStatus = Cells(r, 5).Value         End If         If Cells(r, 6).Value > 0 Then             myApt.ReminderSet = True             myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value         Else             myApt.ReminderSet = False         End If         myApt.Body = Cells(r, 7).Value         myApt.Save         r = r + 1     Loop End Sub

宏继续循环浏览各行，直到“主题”列为空。

注意：

如果您想知道如何使用此页面（或_ExcelTips_网站上的任何其他页面）中描述的宏，我准备了一个特殊页面，其中包含有用的信息。

点击此处在新的浏览器标签中打开该特殊页面。

_ExcelTips_是您进行经济高效的Microsoft Excel培训的来源。

本技巧（7349）适用于Microsoft Excel 97、2000、2002和2003。