Reminder Not set Appointment

T

tessray

Joined
Apr 12, 2009
Messages
2
Reaction score
0
I am writing an application that will add appointments to users calender in outlook. Adding an appointment to a calender is working but I cannot get the reminder set. I need to have the pop up reminder happen before the appointment.

Here is the code I am using. The reminder is set to 6000 and should go off ten minutes before the appointment. But when I open the appointment in outlook the reminder is never set.

Visual studio 2005 Professional edition.
Outlookk 2003
Exchange Server


Private Sub btnTest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTest.Click

Try


Dim sLocation As String = "My place"
Dim sSubject As String = "Dude can you dig this"
Dim sBody As String = "Body message"
Dim cdoTZ As CDO.CdoTimeZoneId = CDO.CdoTimeZoneId.cdoMelbourne
Dim sUser As String = "test1"
Dim dStart As Date = DateAdd(DateInterval.Minute, 10, Date.Now)
Dim dEnd As Date = DateAdd(DateInterval.Minute, 10, Date.Now)

CreateReminder(sLocation, sSubject, sBody, cdoTZ, sUser, dStart, dEnd)

Catch ex As Exception
displayError(ex)
End Try
End Sub

Public Sub CreateReminder(ByVal sLocation As String, _
ByVal sSubject As String, _
ByVal sBody As String, _
ByVal cdoTZ As CDO.CdoTimeZoneId, _
ByVal sUser As String, _
ByVal dStart As Date, _
ByVal dEnd As Date)

Dim sURL As String
Dim oCn As ADODB.Connection = New ADODB.Connection()
Dim oFields As ADODB.Fields
Dim oApp As CDO.Appointment = New CDO.Appointment()

Try

sURL = "http://" & gVars.sExchangeIP & "/Exchange/" & sUser & "/calendar"
oCn.Provider = "exoledb.datasource"

oCn.Open(sURL, "", "", 0)
If oCn.State = 1 Then
LogIt("Connection to Exchange working")
Else
LogIt("Connection to Exchange Failed!!!!")
Return
End If

Dim iConfg As CDO.Configuration = New CDO.Configuration()

oFields = iConfg.Fields
oFields.Item(CDO.CdoCalendar.cdoTimeZoneIDURN).Value = cdoTZ
oFields.Item(CDO.CdoCalendar.cdoReminderOffset).Value = 6000
oFields.Update()

oApp.Configuration = iConfg

oApp.StartTime = dStart
oApp.EndTime = dEnd

oApp.Location = sLocation
oApp.Subject = sSubject
oApp.TextBody = sBody
oApp.BusyStatus = "Free"

' Save to the folder
oApp.DataSource.SaveToContainer(sURL, , _
ADODB.ConnectModeEnum.adModeReadWrite, _
ADODB.RecordCreateOptionsEnum.adCreateNonCollection, _
ADODB.RecordOpenOptionsEnum.adOpenSource, _
gVars.sEXAdMinUserName, _
gVars.sEXAdminPassword)

LogIt("Reminder added sucessfully")

Catch ex As Exception
displayError(ex)

Finally
oCn.Close()
oApp = Nothing
oCn = Nothing
oFields = Nothing
End Try

End Sub

Thanks for any help
 
Working code. I fidured out a whole bunch of errors with the above code. Here is a working sub that adds a reminder.

Public Sub CreateReminderCDO(ByVal sLocation As String, _
ByVal sSubject As String, _
ByVal sBody As String, _
ByVal sUser As String, _
ByVal dStart As Date, _
ByVal dEnd As Date, _
ByVal iReminderMinutesOffset As Integer)

Dim sURL As String
Dim oCn As ADODB.Connection = New ADODB.Connection()
Dim oFields As ADODB.Fields
Dim oApp As CDO.Appointment = New CDO.Appointment()

Try

sURL = "http://" & gVars.sExchangeIP & "/Exchange/" & sUser & "/calendar"
oCn.Provider = "exoledb.datasource"

oCn.Open(sURL, "", "", 0)
If oCn.State = 1 Then

LogIt("Connection to Exchange working")
Else
LogIt("Connection to Exchange Failed!!!!")
Return
End If

Dim iConfg As CDO.Configuration = New CDO.Configuration()

oApp.Fields.Item(CDO.CdoCalendar.cdoReminderOffset).Value = iReminderMinutesOffset * 60
oApp.Fields.Update()

oApp.StartTime = dStart
oApp.EndTime = dEnd

oApp.Location = sLocation
oApp.Subject = sSubject
oApp.TextBody = sBody
oApp.BusyStatus = "Free"

' Save to the folder
oApp.DataSource.SaveToContainer(sURL, , _
ADODB.ConnectModeEnum.adModeReadWrite, _
ADODB.RecordCreateOptionsEnum.adCreateNonCollection, _
ADODB.RecordOpenOptionsEnum.adOpenSource, _
gVars.sEXAdMinUserName, _
gVars.sEXAdminPassword)

LogIt("Reminder added sucessfully")

Catch ex As Exception
displayError(ex)

Finally
oCn.Close()
oApp = Nothing
oCn = Nothing
oFields = Nothing
End Try

End Sub
 
Back
Top