# Merge Excel dates into Outlook Calendar



## blue4197 (Feb 5, 2007)

I have an Excel spreadsheet with dates of tasks to accomplish that I would like to merge into Outlook. Column A has the due date and column B has the task that needs to be completed. 

Thanks for any help.


----------



## Zack Barresse (Jul 25, 2004)

Hi there,

You might try something like this ....


```
Sub ExportTasksToOutlook()
    'Reference set to (Tools | References) ...
    'Microsoft Outlook 12.0 Object Library
    'Exchange "12.0" with your version number
    'Outlook 2007 = 12.0
    'Outlook 2003 = 11.0
    'Outlook 2002 = 10.0
    'Outlook 2000 = 9.0
    Dim olApp As Outlook.Application
    Dim blnCreated As Boolean
    Dim arrTasks() As Variant, i As Long
    arrTasks = Range("A2", Cells(Rows.Count, "B").End(xlUp)).Value
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
        blnCreated = True
        Err.Clear
    Else
        blnCreated = False
    End If
    On Error GoTo 0
    For i = LBound(arrTasks) To UBound(arrTasks)
        With olApp.CreateItem(olTaskItem)
            .DueDate = arrTasks(i, 1)
            .Subject = arrTasks(i, 2)
            .Save
'            .Close
        End With
    Next i
    If blnCreated = True Then
        olApp.Quit
    End If
End Sub
```
This assumes it will work on the activesheet and that you have a header for each column.

HTH


----------



## Kapitein (Apr 16, 2008)

Great, I got the tasks version working. Now I'm trying the same for appointments but for some reason this won't work. Excel only provides me with an error box with no further description of the error (no text at all).

Greatly appreciated if you can indicate what is wrong with my code:


```
Sub ExportAppointmentsToOutlook()

    Dim olApp As Outlook.Application
    Dim olApt As AppointmentItem
    Dim blnCreated As Boolean
    
'Read the table with appointments:
    Dim arrAppt() As Variant, i As Long
    arrAppt = Range("A2", Cells(Rows.Count, "E").End(xlUp)).Value
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
        blnCreated = True
        Err.Clear
    Else
        blnCreated = False
    End If
    On Error GoTo 0

'Create the outlook item for the table entries:
'Rows:
' Row 1 = date
' Row 2 = starttime
' Row 3 = endtime
' Row 4 = Description
' Row 5 = Location

Set olApp = New Outlook.Application
    Set olApt = olApp.CreateItem(olAppointmentItem)

    With olApt
        .Start = arrAppt(i, 1) + 1 + arrAppt(i, 2)
        .End = arrAppt(i, 1) + 1 + arrAppt(i, 3)
        .Subject = arrAppt(i, 4)
        .Location = arrAppt(i, 5)
        .Body = "Created by excel tool"
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 5
        .ReminderSet = True
        .Save
    End With



    Set olApt = Nothing
    Set olApp = Nothing

End Sub
```


----------



## jimr381 (Jul 20, 2007)

Have you looked into importing the data from "File" on the menu bar then "Import and Export data?" It is a very simple wizard to use.


----------



## Kapitein (Apr 16, 2008)

Yes I have but I would prefer to solve it through VBA.


----------



## computerman29642 (Dec 4, 2007)

Just out of curiosity, why do you want to stick with VBA?


----------



## Kapitein (Apr 16, 2008)

Well, first of all I havn't got the import function working properly. I'm sure that if I spend some more time I will get it working though. 
Second (more important) reason is that I would like to make the excel macro part of a larger excel file with a scheduling application to export appointments to outlook. I would prefer to do this through a macro button instead of a complex import/export proces.


----------



## Zack Barresse (Jul 25, 2004)

I think you have it backwards. The import/export process is not complex.. the VBA is going to be complex. And that is because you're trying to do something natively done in another application through Excel. Square peg, round hole. I'm sure we can make it work, but the question is would it be best if we made it work that way.

You should have started a new thread and linked this one instead of hijacking it. Briefly looked at your code.


```
Set olApp = New Outlook.Application
```
Not sure why that line is even in there. You've created an instance of it earlier in the code, why create a new instance?? You're wasting resources there.

Since you are using Early Binding, you must have a version you are using. What is the reference (under Tools | References)?

What values are arrAppt being populated with? Have you checked at runtime? (Note you should reference the worksheet when referencing the range, just creates less headaches.)

Also, in particular with this section of code...

```
With olApt
        .Start = arrAppt(i, 1) + 1 + arrAppt(i, 2)
        .End = arrAppt(i, 1) + 1 + arrAppt(i, 3)
        .Subject = arrAppt(i, 4)
        .Location = arrAppt(i, 5)
        .Body = "Created by excel tool"
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 5
        .ReminderSet = True
        .Save
    End With
```
Looks like you want to loop through your range, but I don't see a loop at all, let alone a value for i. ???


----------



## Kapitein (Apr 16, 2008)

Zach,

Thanks for the pointers. I've got it working. Not so smart of me to forget the FOR/NEXT loop. My apologies for any inconvenience I have caused by posting to this thread instead of making a new one.

If anyone is interested here is the code:


```
Sub ExportAppointmentsToOutlook()

    Dim olApp As Outlook.Application
    Dim olApt As AppointmentItem
    Dim blnCreated As Boolean
    
'Read the table with appointments:
    Dim arrAppt() As Variant, i As Long
    arrAppt = Range("A2", Cells(Rows.Count, "E").End(xlUp)).Value
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
        blnCreated = True
        Err.Clear
    Else
        blnCreated = False
    End If
    On Error GoTo 0

'Create the outlook item for the table entries:
'Rows:
' Row 1 = date
' Row 2 = starttime
' Row 3 = endtime
' Row 4 = Description
' Row 5 = Location

    For i = LBound(arrAppt) To UBound(arrAppt)
    Set olApt = olApp.CreateItem(olAppointmentItem)

    With olApt
        .Start = arrAppt(i, 1) + arrAppt(i, 2)
        .End = arrAppt(i, 1) + arrAppt(i, 3)
        .Subject = arrAppt(i, 4)
        .Location = arrAppt(i, 5)
        .Body = "Created by excel tool"
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 5
        .ReminderSet = True
        .Save
    End With
    Next i


    Set olApt = Nothing
    Set olApp = Nothing

End Sub
```
P.S. To answer your question, I've referenced Outlook 2003 through: Tools | References | Microsoft Outlook 11.0 Object Library


----------



## Zack Barresse (Jul 25, 2004)

Thanks for posting the solution!


----------

