从excel导入日期到Outlook日历

我在做什么是导入日期我有一个特定的列“E”我的Outlook日历我有一个编码开始，但是它不是完全的功能，它只是添加某些日期我的日历，它没有添加我看起来像多个日期为ex.The 6/2的日期被添加到我的日历与正确的主题日期和正文，但日期为6/1我有一个空插槽。有什么建议么？从excel导入日期到Outlook日历

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

来源

2016-05-23 Luis

因为'如果olApptSearch是Nothing Then'它不会添加多个日期。关于跳过日期，请在'sSubject'中输入一些'debug.prints'，但很难说：/这需要一步一步的调试。 – findwindow

@findwindow有关如何更改olApptSearch添加多个日期的建议？ – Luis

我应该承认，我不使用Outlook，所以这只是我的猜测。所以不，我不知道：/也许你可以添加日期作为搜索条件？ – findwindow

尝试这种方式。

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

您的设置将如下所示。

我谈这个概念，和其他类似的，但不同的很多，在我的书的事情。

https://www.amazon.com/Automating-Business-Processes-Reducing-Increasing-ebook/dp/B01DJJKVZC?ie=UTF8&keywords=ryan%20shuell&qid=1464361126&ref_=sr_1_1&sr=8-1

来源

2016-05-27 15:01:32 ryguy7272

从excel导入日期到Outlook日历

回答

相关问题