adding outlook appointments via vb

  • Thread starter Thread starter Rengade
  • Start date Start date
R

Rengade

Hi all

I am trying to add a number of appoitments into outlook via access table and
using the below code

----------------
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem

Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblApptExport")
MyRS.MoveFirst

Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)

Do Until MyRS.EOF

' Save record first to be sure required fields are filled
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
With outappt
.Subject = Me!ApptSubject
.Start = Me!ApptDate & " " & Me!ApptStartTime
.End = Me!ApptDate & " " & Me!ApptEndTime
.location = Me!ApptLocation
.ReminderSet = False
.Save
MyRS.MoveNext
End With
Loop
MsgBox "Appointments Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub

----------------------------

The loop doesn't seem to work as I only get the first record exported into
outlook

Please help
 
Your use of Me!ApptSubject, Me!ApptDate, Me!ApptStartTime and so on means
that you're getting values from the current row on the form, not from the
recordset.

Assuming that the data's supposed to be coming from the recordset, you need
to use

Do Until MyRS.EOF

' Save record first to be sure required fields are filled
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
With outappt
.Subject = MyRS!ApptSubject
.Start = MyRS!ApptDate & " " & MyRS!ApptStartTime
.End = MyRS!ApptDate & " " & MyRS!ApptEndTime
.location = MyRS!ApptLocation
.ReminderSet = False
.Save
End With
MyRS.MoveNext
Loop

Incidentally, you'd be better off storing the appointment start and end
times as timestamps (both the date and the time), rather than separate
fields. If you want only the date portion, use the DateValue function. If
you want only the time portion, use the TimeValue function.
 
Hi all

I am trying to add a number of appoitments into outlook via access table and
using the below code

----------------
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem

Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblApptExport")
MyRS.MoveFirst

Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)

Do Until MyRS.EOF

' Save record first to be sure required fields are filled
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
With outappt
.Subject = Me!ApptSubject
.Start = Me!ApptDate & " " & Me!ApptStartTime
.End = Me!ApptDate & " " & Me!ApptEndTime
.location = Me!ApptLocation
.ReminderSet = False
.Save
MyRS.MoveNext
End With
Loop
MsgBox "Appointments Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub

----------------------------

The loop doesn't seem to work as I only get the first record exported into
outlook

Please help
Click to expand...
 
On Wed, 16 Jul 2008 05:35:18 -0700, Rengade

I think mostly a matter of putting things in the right location,
especially creating a new apptitem within the loop:

DoCmd.RunCommand acCmdSaveRecord
MyRS.MoveFirst
Set outobj = CreateObject("outlook.application")
Do Until MyRS.EOF
Set outappt = outobj.CreateItem(olAppointmentItem)
With outappt

-Tom.
 
Many thanks,

I have changed the code as suggested to the below, I am now getting the
error message "Error 3265 Item not found in this collection"
===========================================
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem

Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblApptExport")
DoCmd.RunCommand acCmdSaveRecord
MyRS.MoveFirst
Set outobj = CreateObject("outlook.application")
Do Until MyRS.EOF
DoCmd.RunCommand acCmdSaveRecord
With outappt
.Subject = MyRS!ApptSubject
.Start = MyRS!ApptDate & " " & MyRS!ApptStartTime
.End = MyRS!ApptDate & " " & MyRS!ApptEndTime
.location = MyRS!ApptLocation
.ReminderSet = False
.Save
End With
MyRS.MoveNext
Loop

MsgBox "Appointments Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
===============================
 
Sorry that was just me being stupid, have now changed the code to below
getting error message: "error 91 - Object variable or With block variable not
set"

Any ideas???


==============================
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem

Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblApptExport")
DoCmd.RunCommand acCmdSaveRecord
MyRS.MoveFirst
Set outobj = CreateObject("outlook.application")
Do Until MyRS.EOF
DoCmd.RunCommand acCmdSaveRecord
With outappt
.Subject = MyRS!Course
.Start = MyRS!StdCourseDate & " " & MyRS!StdCourseStartTime
.End = MyRS!StdCourseDate & " " & MyRS!FinishTime
.location = MyRS!StdCourseLocation
.ReminderSet = False
.Save
End With
MyRS.MoveNext
Loop

MsgBox "Appointments Added!"
Exit Sub
===============================
 
the below code now works.....but it only seems to add the last record in the
table and not the other 3 records before it...... any idea's please?????

=================================
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem

Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblApptExport")
DoCmd.RunCommand acCmdSaveRecord
MyRS.MoveFirst
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)

Do Until MyRS.EOF
DoCmd.RunCommand acCmdSaveRecord
With outappt
.Subject = MyRS!Course
.Start = MyRS!StdCourseDate & " " & MyRS!StdCourseStartTime
.End = MyRS!StdCourseDate & " " & MyRS!FinishTime
.location = MyRS!StdCourseLocation
.ReminderSet = False
.Save
End With
MyRS.MoveNext
Loop
=========================
 
As was pointed out yesterday (not by me), you need to create the new
appointment item inside the loop:

Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblApptExport")
MyRS.MoveFirst
Set outobj = CreateObject("outlook.application")

Do Until MyRS.EOF
Set outappt = outobj.CreateItem(olAppointmentItem)
With outappt
.Subject = MyRS!Course
.Start = MyRS!StdCourseDate & " " & MyRS!StdCourseStartTime
.End = MyRS!StdCourseDate & " " & MyRS!FinishTime
.location = MyRS!StdCourseLocation
.ReminderSet = False
.Save
End With
Set outappt = Nothing
MyRS.MoveNext
Loop

Note that I removed the "DoCmd.RunCommand acCmdSaveRecord": I don't believe
they're necessary (especially not inside the loop)
 
Back
Top