Appointments

Status
Not open for further replies.

Chrystel

New Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server 2013
Having trouble using macro given for creating appointments from Excel spreadsheet data.
I have copied and pasted the macro below yet keep getting error message "Use-defined type not defined":

Option Explicit
Public Sub CreateOutlookApptz()
Sheets("Sheet1").Select
On Error GoTo Err_Execute

Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim blnCreated As Boolean
Dim olNs As Outlook.Namespace
Dim CalFolder As Outlook.MAPIFolder
Dim subFolder As Outlook.MAPIFolder
Dim arrCal As String

Dim i As Long

On Error Resume Next
Set olApp = Outlook.Application

If olApp Is Nothing Then
Set olApp = Outlook.Application
blnCreated = True
Err.Clear
Else
blnCreated = False
End If

On Error GoTo 0

Set olNs = olApp.GetNamespace("MAPI")
Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)

i = 2
Do Until Trim(Cells(i, 1).Value) = ""
arrCal = Cells(i, 1).Value
Set subFolder = CalFolder.Folders(arrCal)

Set olAppt = subFolder.Items.Add(olAppointmentItem)

'MsgBox subFolder, vbOKCancel, "Folder Name"

With olAppt

'Define calendar item properties
.Start = Cells(i, 6) + Cells(i, 7) '+ TimeValue("9:00:00")
.End = Cells(i, 8) + Cells(i, 9) '+TimeValue("10:00:00")
.Subject = Cells(i, 2)
.Location = Cells(i, 3)
.Body = Cells(i, 4)
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = Cells(i, 10)
.ReminderSet = True
.Categories = Cells(i, 5)
.Save

End With

i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing

Exit Sub

Err_Execute:
MsgBox "An error occurred - Exporting items to Calendar."

End Sub

I am using Outlook 2013 & Excel 2013.
I received macro info from site below:
http://www.slipstick.com/developer/create-appointments-spreadsheet-data/

Anyone have any ideas?
 
If the code runs in Excel, you need to set a reference to the "Microsoft Outlook x Object Library" via Tools/References.
I will see if I can figure this out and apply it. Hope it works and thanks much for responding.
 
If the code runs in Excel, you need to set a reference to the "Microsoft Outlook x Object Library" via Tools/References.
Okay, I set the reference and the next error I got when trying to run the macro is: Compile error-Invalid inside procedure. Is the script correct for Outlook 2013 & Excel 2013
 
which line of code is highlighted?
Also the following is highlighted when I delete and tried macro again.

Yellow highlighted: Private Sub CommandButton1_Click()
Blue highlighted: Option Explicit
 
The code (from Option Explicit to End Sub) doesn't throw that error. There must be more that we don't see.
 
Blue is what you select, that doesn't matter. Where comes the new line from? The declaration of a procedure (sub) must not be within another procedure, that is not between a sub whatever() ... end sub
 
The code (from Option Explicit to End Sub) doesn't throw that error. There must be more that we don't see.
Pasted below is the entire macro as it gives the error with the first 2 lines highlighted, 1st in yellow and second in blue, no other lines are highlighted:

Option Explicit

Private Sub CommandButton1_Click()
Option Explicit
Public Sub CreateOutlookApptz()
Sheets("Sheet1").Select
On Error GoTo Err_Execute

Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim blnCreated As Boolean
Dim olNs As Outlook.Namespace
Dim CalFolder As Outlook.MAPIFolder
Dim subFolder As Outlook.MAPIFolder
Dim arrCal As String

Dim i As Long

On Error Resume Next
Set olApp = Outlook.Application

If olApp Is Nothing Then
Set olApp = Outlook.Application
blnCreated = True
Err.Clear
Else
blnCreated = False
End If

On Error GoTo 0

Set olNs = olApp.GetNamespace("MAPI")
Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)

i = 2
Do Until Trim(Cells(i, 1).Value) = ""
arrCal = Cells(i, 1).Value
Set subFolder = CalFolder.Folders(arrCal)

Set olAppt = subFolder.Items.Add(olAppointmentItem)

'MsgBox subFolder, vbOKCancel, "Folder Name"

With olAppt

'Define calendar item properties
.Start = Cells(i, 6) + Cells(i, 7) '+ TimeValue("9:00:00")
.End = Cells(i, 8) + Cells(i, 9) '+TimeValue("10:00:00")
.Subject = Cells(i, 2)
.Location = Cells(i, 3)
.Body = Cells(i, 4)
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = Cells(i, 10)
.ReminderSet = True
.Categories = Cells(i, 5)
.Save

End With

i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing

Exit Sub

Err_Execute:
MsgBox "An error occurred - Exporting items to Calendar."

End Sub
End Sub
 
This is allowed:
sub abc()
end sub
sub xyz()
end sub

this is not allowed:
sub abc()
sub xyz()
end sub
 
This is allowed:
sub abc()
end sub
sub xyz()
end sub

this is not allowed:
sub abc()
sub xyz()
end sub

Unfortunately I am not a wiz at this sort of thing and have tried everything that I know to do. The ability to take my excel info and export into my outlook in order to have reminders for appointments would be such a benefit to me. I know that it can be done. I do not understand why all of this is not working for me. :(
 
From the entire code you're showing, delete the first two lines, and the last one.
 
From the entire code you're showing, delete the first two lines, and the last one.
Thanks so much for helping with this. I have tried the macro again correcting it as you have suggested. No go. The very first line is highlighted by yellow. "Public Sub CreateOutlookApptz()".
I am wondering if my Excel spreadsheet/workbook may have the problem in it.
 
If the same error occurs, you deleted the wrong lines. If so, show the entire code, please. If you get another error message now, tell what it's saying.
 
If the same error occurs, you deleted the wrong lines. If so, show the entire code, please. If you get another error message now, tell what it's saying.

upload_2014-6-19_8-14-23.png


Public Sub CreateOutlookApptz()
Sheets("Sheet1").Select
On Error GoTo Err_Execute

Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim blnCreated As Boolean
Dim olNs As Outlook.Namespace
Dim CalFolder As Outlook.MAPIFolder
Dim subFolder As Outlook.MAPIFolder
Dim arrCal As String

Dim i As Long

On Error Resume Next
Set olApp = Outlook.Application

If olApp Is Nothing Then
Set olApp = Outlook.Application
blnCreated = True
Err.Clear
Else
blnCreated = False
End If

On Error GoTo 0

Set olNs = olApp.GetNamespace("MAPI")
Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)

i = 2
Do Until Trim(Cells(i, 1).Value) = ""
arrCal = Cells(i, 1).Value
Set subFolder = CalFolder.Folders(arrCal)

Set olAppt = subFolder.Items.Add(olAppointmentItem)

'MsgBox subFolder, vbOKCancel, "Folder Name"

With olAppt

'Define calendar item properties
.Start = Cells(i, 6) + Cells(i, 7) '+ TimeValue("9:00:00")
.End = Cells(i, 8) + Cells(i, 9) '+TimeValue("10:00:00")
.Subject = Cells(i, 2)
.Location = Cells(i, 3)
.Body = Cells(i, 4)
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = Cells(i, 10)
.ReminderSet = True
.Categories = Cells(i, 5)
.Save

End With

i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing

Exit Sub

Err_Execute:
MsgBox "An error occurred - Exporting items to Calendar."

End Sub
 
We are moving in a circle. If
Dim olApp As Outlook.Application
is again highlighted blue, you need to set the reference to the Outlook library.
 
We are moving in a circle. If
Dim olApp As Outlook.Application
is again highlighted blue, you need to set the reference to the Outlook library.
This has already been done.

upload_2014-6-19_9-38-32.png


upload_2014-6-19_9-40-14.png


I really cannot understand why this is not working. :(
 
We are moving in a circle. If
Dim olApp As Outlook.Application
is again highlighted blue, you need to set the reference to the Outlook library.

Okay, I cleared and reran everything. I now get the following error:

upload_2014-6-19_10-15-17.png
 
I asked you to add a ref to the Outlook library, not Office.

As to the new error, I cannot help if you don't tell us where the error occurs. Every mentioned error is highlighted, please tell us where that is.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
A Outlook 365 New Appointments All saved to a 365 default calendar on Mac Using Outlook 0
M New Calendar Appointments: Conditionally turn off reminder and show time as free Using Outlook 5
Kika Melo Outlook Calendar deleted appointments not in Deleted Items folder Using Outlook 3
e_a_g_l_e_p_i Outlook 2021 all appointments not showing in calendar Using Outlook 2
S Changing colors of today's appointments, but not recurring ones Using Outlook 33
M Printing Appointments Using Outlook 1
M Calendar daily Appointments and printing Using Outlook 0
C Add Form to Appointments Received, Automatically Outlook VBA and Custom Forms 6
L Option to Show Cancelled Appointments Using Outlook 0
O Export Outlook calendar appointments by filters and date range Outlook VBA and Custom Forms 1
R Outlook 2007 only loads some appointments Using Outlook 0
N Gathering Calendar Appointments from Calendars that synced as Contacts Exchange Server Administration 1
F Year-and-a-day recurring appointments Using Outlook 1
J what file contains contacts, tasks and appointments stored locally? Using Outlook 1
D hiding appointments that are completed or cancelled, how to ? Using Outlook 5
M warning for too many appointments on a same day in Outlook Using Outlook 1
V importing appointments to non-default calendar? Using Outlook 1
OutlookIntegrator Appointments Using Outlook 0
R Make past appointments remain in calendar Using Outlook 1
M Creating Outlook Appointments from Excel Cells Outlook VBA and Custom Forms 1
A Outlook.com changing appointments Using Outlook 8
T populate calendar with appointments and send reminders Using Outlook 1
Diane Poremsky Copy New Appointments to Another Calendar using VBA Using Outlook 0
Diane Poremsky Create Appointments Using Spreadsheet Data Using Outlook 0
Diane Poremsky How to Import Appointments into a Group Calendar Using Outlook 0
I Outlook 2013 Appointments not in HTML Using Outlook.com accounts in Outlook 2
makinmyway Appointments Created in iCloud Calendars Cover Contacts Field...Why? Using Outlook 3
M Expected behaviour of recurring appointments? Using Outlook 2
C Find all deleted recurrence appointments Outlook VBA and Custom Forms 4
M Copy new appointments created in multiple shared calendars to another exchange calendar Outlook VBA and Custom Forms 1
R Outlook calendar appointments Free/Busy time is changing from "Busy" to "Free" Using Outlook 2
G Outlook does not show new appointments in To-Do-Bar Using Outlook 0
A Looping appointments in calendar Outlook VBA and Custom Forms 0
B Outlook Calendar/setting appointments Using Outlook 1
L Appointments disappearing Using Outlook 0
N To do bar - show more than 30 days of appointments Using Outlook 0
A Show ALL of today's appointments in To-Do Bar Using Outlook 1
F Outlook 2007 Calendar Appointments not in Outlook Today view Using Outlook 11
A Can't stop Outlook.com from setting reminders on appointments? Using Outlook.com accounts in Outlook 3
S Outlook 2013 Appointments missing Using Outlook 1
N Outlook Shared appointments automatically to Private Calendar Using Outlook 1
A Synchronize Access Table with Outlook Calendar Appointments Outlook VBA and Custom Forms 3
J Change reminder times of future appointments Using Outlook 1
Mark Rideout Search folder for appointments and emails Using Outlook 2
C Appointments from Excel to Outlook Using Outlook 3
C Appointments Exchange Server Administration 4
I Adding appointments/tasks to other user's calendar Using Outlook 1
R Getting a colleagues appointments and calendar entries Using Outlook 1
N Outlook 2010 Archived Appointments Missing Using Outlook 5
Katrina Fox Missing appointments on calendar even though transferred from old pst Using Outlook 0

Similar threads

Back
Top