從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日曆

回答

相關問題