Home |
Search |
Today's Posts |
#2
![]() |
|||
|
|||
![]() Quote:
Its difficult to know without more info but I guess some form of lookup could work. Alternatively and possibly a better solution would be to use VBA to import your list to the Microsoft Outlook calendar. Not much outlook code exists out there but I have some untested code that imports data from excel to outlooks calendar. Not having tried it yet I can't tell you if it works properly! but would be one solution here it is and is based on your data starting in row 2 ("iRow") with column 1 as 'subject' column 2 as 'name' 3 as 'categories' and so on as you follow the code through 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).Work sheets(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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Convert list of events to calendar format | Excel Discussion (Misc queries) | |||
create calendar with only M-F and add multiple repeating events | Excel Discussion (Misc queries) | |||
monthly cycle events to add to calendar object | Excel Discussion (Misc queries) | |||
Calendar that automatically push events back one day. | Excel Discussion (Misc queries) | |||
Ploting dates against a calendar and not as a simple events | Charts and Charting in Excel |