Dates from Excel into Outlook

MrAdamRe · #1 03-16-2015, 08:22 PM

I want to transfer a excel column of about 50 dates directly onto my calendar in outlook. Is that possible?

gmayor · #2 03-16-2015, 11:22 PM

The short answer is yes, and you can do it from Excel or Outlook, but dates alone aren't going to convey much. What information do you want to add to the appointments?

MrAdamRe · #3 03-16-2015, 11:35 PM

I just want it to note that "Payroll Info Due" on each of the dates

gmayor · #4 03-17-2015, 12:45 AM

OK - The following should do that

Code:

Sub AddOutlookApptmnt()
Dim xlSheet As Worksheet
Dim olApp As Object
Dim objAppt As Object
Dim strDate As String
Dim strTime As String
Dim datOutlookDate As Date
Dim i As Long
Dim LastRow As Long
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    Set xlSheet = ActiveWorkbook.Sheets(1)
    With xlSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To LastRow        'Assumes a header row
            strDate = .Cells(i, "A")
            strTime = "07:00"
            datOutlookDate = CDate(strDate & " " & strTime)
            Set objAppt = olApp.CreateItem(1)
            With objAppt
                .Start = datOutlookDate
                .ReminderSet = True
                .AllDayEvent = True
                .Subject = "Payroll Info Due"
                .BusyStatus = 0
                .Save
            End With
        Next i
    End With
lbl_Exit:
    Set olApp = Nothing
    Set objAppt = Nothing
    Exit Sub
End Sub

The code for creating a task, which might be preferable, is similar:

Code:

Sub AddOutlookTask()
Dim xlSheet As Worksheet
Dim olApp As Object
Dim olTask As Object
Dim strDate As String
Dim i As Long
Dim LastRow As Long
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    Set xlSheet = ActiveWorkbook.Sheets(1)
    With xlSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To LastRow        'Assumes a header row
            strDate = .Cells(i, "A")
            Set olTask = olApp.CreateItem(3)
            With olTask
                .Subject = "Payroll Info Due"
                .StartDate = strDate
                .DueDate = strDate
                .Importance = 2
                '.Categories = "Payroll" 'add a category of your choice
                .Save
            End With
        Next i
    End With
lbl_Exit:
    Set olApp = Nothing
    Set olTask = Nothing
    Exit Sub
End Sub

Both codes run very quickly and nothing may appear to have happened, but check your Outlook

MrAdamRe · #5 03-17-2015, 06:10 AM

ahem... Can I just say WOW! I am so impressed. Thank you so much

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Unable to sort dates in Excel on new PC	freebird795	Excel	3	12-07-2014 03:06 PM
Excel is changing dates.	laqa	Excel	5	11-06-2014 07:26 PM
Grouping Dates in Excel Pivot Table	mskennedy	Excel	2	02-27-2013 11:09 AM
Excel 2010 - Converting fractions into dates	judicial85	Excel	5	12-31-2011 07:59 AM
MS Excel 2004 for Mac - copying dates between documents	BCRenton	Excel	4	11-10-2009 07:28 AM