Cookies help us deliver our services. By using our services, you agree to our use of cookies.
Tip: Other languages are Google-Translated. You can visit the English version of this link.
Log in


How to create appointment from Excel data?

Supposing, you have a table of appointment data in an Excel worksheet as following screenshot shown, now, you want to import these data into the Outlook calendar. How could you deal with this job quickly?

doc export excel data to appointment 1

Create appointments from Excel data with VBA code

Create appointments from Excel data with VBA code

To create appointments from Excel data, you can apply the following VBA code, please do as this:

1. Launch Outlook and hold down the ALT + F11 keys to open the Microsoft Visual Basic for Applications window.

2. Click Insert > Module, and paste the following code in the Module Window.

VBA code: Import excel data to appointment:

Public Sub CreateOutlookApptz()
    Dim xAppointmentItem As Outlook.AppointmentItem
    Dim xNameSpace As Outlook.NameSpace
    Dim xCalendarFld As Outlook.MAPIFolder, xSubFolder As Outlook.MAPIFolder
    Dim xCalendarStr As String
    Dim I As Long
    Dim xFileDialog As FileDialog
    Dim xFilePath As String
    Dim xExcelApp As Excel.Application
    Dim xWb As Workbook
    Dim xWs As Worksheet
    On Error GoTo Err_Execute
    Set xExcelApp = New Excel.Application
    Set xFileDialog = xExcelApp.FileDialog(msoFileDialogFilePicker)
    With xFileDialog
        .Title = "Select a file"
        .Filters.Add "Microsoft Excel", "*.xlsx"
    End With
    If xFileDialog.Show = 0 Then Exit Sub
    xFilePath = xFileDialog.SelectedItems(1)
    Set xWb = xExcelApp.Workbooks.Open(xFilePath)
    Set xNameSpace = Outlook.Application.Session
    Set xCalendarFld = xNameSpace.GetDefaultFolder(olFolderCalendar)
    I = 2
    Set xWs = xWb.Worksheets.Item(1)
    xCalendarStr = xWb.Name
    If FolderExist(xCalendarFld, xCalendarStr) = False Then
        Set xSubFolder = xCalendarFld.Folders.Add(xCalendarStr, olFolderCalendar)
        Set xSubFolder = xCalendarFld.Folders(xCalendarStr)
    End If
    Do Until Trim(xWs.Cells(I, 1).Value) = ""
        Set xAppointmentItem = xSubFolder.Items.Add(olAppointmentItem)
        With xAppointmentItem
            .Start = xWs.Cells(I, 5) + xWs.Cells(I, 6)
            .End = xWs.Cells(I, 7) + xWs.Cells(I, 8)
            .Subject = xWs.Cells(I, 1)
            .Location = xWs.Cells(I, 2)
            .Body = xWs.Cells(I, 3)
            .BusyStatus = olBusy
            .ReminderMinutesBeforeStart = xWs.Cells(I, 9)
            .ReminderSet = True
            .Categories = xWs.Cells(I, 4)
        End With
        I = I + 1
    Set xAppointmentItem = Nothing
    Set olApp = Nothing
    Set xExcelApp = Nothing
    MsgBox "Import successfully!", vbInformation, "Kutools for Outlook"
    Exit Sub
    MsgBox "An error occurred - Exporting items to Calendar.", vbInformation, "Kutools for Outlook"
End Sub
Function FolderExist(CalFolder As Folder, FolderName As String) As Boolean
    Dim I As Integer
    Dim xSubFolder As Folder
    For I = 1 To CalFolder.Folders.Count
        Set xSubFolder = CalFolder.Folders.Item(I)
        If xSubFolder.Name = FolderName Then
            FolderExist = True
            Exit Function
        End If
    Next I
End Function

3. Still in the Microsoft Visual Basic for Applications window, click Tools > References to go to the References-Project1 dialog box, and check Microsoft Excel Object Library option from the Available References list box, see screenshot:

doc export excel data to appointment 2

4. Then click OK button, now, press F5 key to run this code, and a Select a file window is displayed, please select the excel file you want to import to Outlook, see screenshot:

doc export excel data to appointment 3

5. And then click OK, a prompt box is popped out as follows:

doc export excel data to appointment 4

6. Then click OK, the Excel data has been imported into the calendar as following screenshot shown:

doc export excel data to appointment 5

Kutools for Outlook

More than 100 Advanced Functions for Outlook 2010, 2013, 2016, 2019 and 365

screen shot kutools for outlook tiny for banner 201812

More Features  |  Free Download  |  Only $39.00 for hundreds of functions

Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.

Be the first to comment.