从Excel导入date到Outlook日历
我正在试图做的是我有一个特定的列“E”导入date到我的Outlook日历我有一个编码开始，但是它不是完全的function，它只是添加某些date到我的日历，它不会增加它看起来我喜欢多个date为ex.The 6/2的date被添加到我的日历与正确的主题date和正文，但date为6/1我有一个空插槽。 有什么build议么？
Option Explicit Public Sub CreateOutlookApptz() Sheets("Sheet2").Select On Error GoTo Err_Execute Dim olApp As OUtlook.Application Dim olAppt As OUtlook.AppointmentItem Dim blnCreated As Boolean Dim olNs As OUtlook.Namespace Dim CalFolder As OUtlook.MAPIFolder Dim subFolder As OUtlook.MAPIFolder Dim arrCal As String Dim i As Long On Error Resume Next Set olApp = OUtlook.Application If olApp Is Nothing Then Set olApp = OUtlook.Application blnCreated = True Err.Clear Else blnCreated = False End If On Error GoTo 0 Set olNs = olApp.GetNamespace("MAPI") Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) i = 2 Do Until Trim(Cells(i, 1).Value) = "" Set subFolder = CalFolder Set olAppt = subFolder.Items.Add(olAppointmentItem) MsgBox Cells(i, 6) + Cells(i, 7) 'MsgBox subFolder, vbOKCancel, "Folder Name" With olAppt 'Define calendar item properties .Start = Cells(i, 6) + Cells(i, 7) .End = Cells(i, 8) + Cells(i, 9) .Subject = Cells(i, 2) .Location = Cells(i, 3) .Body = Cells(i, 4) .BusyStatus = olBusy .ReminderMinutesBeforeStart = Cells(i, 10) .ReminderSet = True .Categories = Cells(i, 5) .Save End With i = i + 1 Loop Set olAppt = Nothing Set olApp = Nothing Exit Sub Err_Execute: MsgBox "An error occurred - Exporting items to Calendar." End Sub 
试试这种方式。
Private Sub Add_Appointments_To_Outlook_Calendar() 'Include Microsoft Outlook nn.nn Object Library from Tools -> References Dim oAppt As AppointmentItem Dim Remind_Time As Double i = 2 Subj = ThisWorkbook.Sheets(1).Cells(i, 1) 'Loop through entire list of Reminders to be added While Subj <> "" Set oAppt = Outlook.Application.CreateItem(olAppointmentItem) oAppt.Subject = Subj oAppt.Location = ThisWorkbook.Sheets(1).Cells(i, 2) oAppt.Start = ThisWorkbook.Sheets(1).Cells(i, 3) Remind_Time = ThisWorkbook.Sheets(1).Cells(i, 4) * 1 * 60 oAppt.ReminderMinutesBeforeStart = Remind_Time oAppt.AllDayEvent = True oAppt.Save i = i + 1 Subj = ThisWorkbook.Sheets(1).Cells(i, 1) Wend MsgBox "Reminder(s) Added To Outlook Calendar" End Sub
你的设置看起来像这样。
我在这本书中讨论这个概念，以及其他许多类似但不同的东西。