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



--
Jacob (MVP - Excel)


"Dan Wood" wrote:

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