Creating Appointment

[Dan Wood]

Is it possible to create an appointment within Outlook using Excel?

The sheet will have a date when passwords expire, and this will be changed
each month. Is there a macro to look at this date and then create an
appointment within the Outlook calendar to say something along the lines of
'Change Password for system xxxxxxxxx' where xxxxxxxxx will be the data in
field A1

Thanks for your help

 

[Jacob Skaria]

With system number in cell A1 and date in cell B1; try the below macro

Sub OLApp()

Dim objOL As Object, objApp As Object
Set objOL = CreateObject("Outlook.Application")

Set objApp = objOL.CreateItem(1)
With objApp
.Subject = "Change Password for system" & Range("A1")
.Start = Range("B1")
.ReminderPlaySound = True
.Save
End With

Set objOL = Nothing
End Sub

 

[Dan Wood]

I have tried that and getting the following error:-

Object doesn't support this property or method (Error 438)

I ran the macro once fine, then it came up with this error. No appointment
went into the calendar either.

Thanks

 

[Jacob Skaria]

I tried this with my outlook instance open.

 

[Dan Wood]

There is no error this time but i cannot find them in the calendar. Is it
anything to do with formatiing the date cell?
Sorry to be a pain!

 

[Jacob Skaria]

Cell B1 of activesheet contains a valid date in excel date format.

 

[Dan Wood]

How stupid can i be!! The date wasn't formatted correctly.

Thank you for that. Next question is:-

How can i set this macro to perform the same actions for multiple cells? So
if coloum A had a list of system names, and coloum B has a list of various
dates, how can the macro scroll down and create the appointments?

 

[Jacob Skaria]

Dan, try the below.........

Sub OLApp()

Dim objOL As Object, objApp As Object, lngRow As Long

Set objOL = CreateObject("Outlook.Application")

For lngRow = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Set objApp = objOL.CreateItem(1)
With objApp
.Subject = "Change Password for system" & Range("A" & lngRow)
.Start = Range("B" & lngRow)
.ReminderPlaySound = True
.Save
End With
Next

Set objOL = Nothing
End Sub

 

[Dan Wood]

That works perfectly. Thanks

Is there a way to stop this creating duplicate appointments? Prehaps a
seperate macro to either check if the appointment is there, or prehaps a new
field to say the appointment has been added, and the macro to skip it, eg if
field c1 says 'Done' move onto the next field

 

[Jacob Skaria]

Modified...

Sub OLApp()

Dim objOL As Object, objApp As Object, lngRow As Long

Set objOL = CreateObject("Outlook.Application")

For lngRow = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("C" & lngRow) = "" Then
Set objApp = objOL.CreateItem(1)
With objApp
.Subject = "Change Password for system" & Range("A" & lngRow)
.Start = Range("B" & lngRow)
.ReminderPlaySound = True
.Save
End With
Range("C" & lngRow) = "Done"
End If
Next

Set objOL = Nothing
End Sub

 

[Dan Wood]

I have amended the script slightly to fit in with the fields that i will be
using but am getting a run time 13 error.

My amended script is:-

Sub OLApp()

Dim objOL As Object, objApp As Object, lngRow As Long

Set objOL = CreateObject("Outlook.Application")

For lngRow = 9 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("E" & lngRow) = "" Then
Set objApp = objOL.CreateItem(1)
With objApp
..Subject = "Change Password for system" & Range("A" & lngRow)
..Start = Range("B" & lngRow)
..ReminderPlaySound = True
..Save
End With
Range("E" & lngRow) = "Done"
End If
Next

Set objOL = Nothing
End Sub


So the system name is in colum A starting from cell 9, then the date is
starting from D9, then the field to say the appointment has been added will
be E9.

 

[Jacob Skaria]

I dont see any reason why this should give an error. Let me know which line
is giving this error.