VB Updating Appointments from Access Query

[BeginnerBen]

I am trying to create Outlook Appointments for our field staff from an
access query that is being pulled from our SQL DB. I am using Visual
Basic. I am getting the information to go to the correct place but
instead of creating a new appointment based on seperate values in the
query it keeps updating the same appointment. This is wildly
frustrating because it is pulling the correct data. But when I send
all the messages there is only one appointment when there should be a
bunch.

Here is the Code:

Private Sub Appointments()

'Add a new appointment.
Dim dbCustomers As Object
Dim rstCustomers As Object
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim IntI As Integer

Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
Set dbCustomers = CurrentDb
Set rstCustomers = dbCustomers.OpenRecordset("Drive
Appointments")
Set objNS = objOutlook.GetNamespace("MAPI")
objNS.Logon


If rstCustomers.RecordCount = 0 Then
MsgBox "No Records To Process"
Exit Sub
End If


objAppt.MeetingStatus = 1


rstCustomers.MoveLast
rstCustomers.MoveFirst
For IntI = 0 To rstCustomers.RecordCount - 1
Do Until rstCustomers.EOF

With objAppt

.RequiredAttendees = rstCustomers.email
.Start = rstCustomers.Expr1
.Duration = rstCustomers.sched_dur
.Subject = rstCustomers.work_no
.ResponseRequested = True


If Not IsNull(rstCustomers.Description) Then .Body =
rstCustomers.location_name & " / " & rstCustomers.addr1 & " / " &
rstCustomers.city & " / " & rstCustomers.state_code
If Not IsNull(rstCustomers.location_name) Then .Location =
rstCustomers.location_name
AddedToOutlook = True
.Save
.Send
rstCustomers.Edit
rstCustomers.Update
IntI = IntI + 1
Set objAppt = Nothing
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
End With

rstCustomers.MoveNext
Exit For
Loop
rstCustomers.Close
Next
Set objAppt = Nothing
MsgBox "Your appointments have been added to your Outlook
Calendar"


'Release the AppointmentItem object variable.
Set objAppt = Nothing
Set objNS = Nothing
Set objOutlook = Nothing
Set SafeItem = Nothing
Set rstCustomers = Nothing


Exit Sub


End Sub

I hope this is an easy fix because I am close to losing my mind.

 

[Cinzia]

I am trying to create Outlook Appointments for our field staff from an
access query that is being pulled from our SQL DB. I am using Visual
Basic. I am getting the information to go to the correct place but
instead of creating a new appointment based on seperate values in the
query it keeps updating the same appointment. This is wildly
frustrating because it is pulling the correct data. But when I send
all the messages there is only one appointment when there should be a
bunch.

Here is the Code:

Private Sub Appointments()

'Add a new appointment.
Dim dbCustomers As Object
Dim rstCustomers As Object
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim IntI As Integer

Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
Set dbCustomers = CurrentDb
Set rstCustomers = dbCustomers.OpenRecordset("Drive
Appointments")
Set objNS = objOutlook.GetNamespace("MAPI")
objNS.Logon


If rstCustomers.RecordCount = 0 Then
MsgBox "No Records To Process"
Exit Sub
End If


objAppt.MeetingStatus = 1


rstCustomers.MoveLast
rstCustomers.MoveFirst
For IntI = 0 To rstCustomers.RecordCount - 1
Do Until rstCustomers.EOF

With objAppt

.RequiredAttendees = rstCustomers.email
.Start = rstCustomers.Expr1
.Duration = rstCustomers.sched_dur
.Subject = rstCustomers.work_no
.ResponseRequested = True


If Not IsNull(rstCustomers.Description) Then .Body =
rstCustomers.location_name & " / " & rstCustomers.addr1 & " / " &
rstCustomers.city & " / " & rstCustomers.state_code
If Not IsNull(rstCustomers.location_name) Then .Location =
rstCustomers.location_name
AddedToOutlook = True
.Save
.Send
rstCustomers.Edit
rstCustomers.Update
IntI = IntI + 1
Set objAppt = Nothing
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
End With

rstCustomers.MoveNext
Exit For
Loop
rstCustomers.Close
Next
Set objAppt = Nothing
MsgBox "Your appointments have been added to your Outlook
Calendar"


'Release the AppointmentItem object variable.
Set objAppt = Nothing
Set objNS = Nothing
Set objOutlook = Nothing
Set SafeItem = Nothing
Set rstCustomers = Nothing


Exit Sub


End Sub

I hope this is an easy fix because I am close to losing my mind.

Hi BeginnerBen,
your question should be posted to microsoft.public.access.modulescoding or
microoft.public.access.interopoledde
In the meantime if I understand your problem I think you have to cancel
from your code the following instuctions:

For IntI = 0 To rstCustomers.RecordCount - 1 .....
rstCustomers.Edit
rstCustomers.Update
IntI = IntI + 1 .....
Exit For ....
Next

you have the do ... loop and so, the for cycle should be unnecessary
Your Exit For before the Loop instruction close the For cycle but also the
Do..loop nested inside the For.
Bye