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?
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) Else 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) .Save End With I = I + 1 Loop Set xAppointmentItem = Nothing Set olApp = Nothing xExcelApp.Quit Set xExcelApp = Nothing MsgBox "Import successfully!", vbInformation, "Kutools for Outlook" Exit Sub Err_Execute: 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:
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:
5. And then click OK, a prompt box is popped out as follows:
6. Then click OK, the Excel data has been imported into the calendar as following screenshot shown:
Kutools for Outlook - Brings 100 Advanced Features to Outlook, and Make Work Much Easier!
- Auto CC/BCC by rules when sending email; Auto Forward Multiple Emails by custom; Auto Reply without exchange server, and more automatic features...
- BCC Warning - show message when you try to reply all if your mail address is in the BCC list; Remind When Missing Attachments, and more remind features...
- Reply (All) With All Attachments in the mail conversation; Reply Many Emails in seconds; Auto Add Greeting when reply; Add Date into subject...
- Attachment Tools: Manage All Attachments in All Mails, Auto Detach, Compress All, Rename All, Save All... Quick Report, Count Selected Mails...
- Powerful Junk Emails by custom; Remove Duplicate Mails and Contacts... Enable you to do smarter, faster and better in Outlook.

