Results 1 to 5 of 5
  1. #1
    Join Date
    Mar 2009
    Posts
    5

    Unanswered: RecordSet Loop Until Problem

    Hi,

    I have table holding appointment details. The script exports the appointments to outlook. I want to script do the following:

    • Add Appointment
    • Mark the Appointment as Added (tick box in the table)
    • Move to the next record


    The problem I have is that I cannot get the loop to work correctly, it keeps adding the appointments. Below is a the code I am using.

    Thanks for any help in advance

    Code:
    Private Sub btnOutExcel_Click()
        DoCmd.OpenQuery "Append 5 Day Forecast"
           
    Set rst = CurrentDb.OpenRecordset("tblAppointments")
    
       With rst
          .MoveFirst
    
          ' Loop through the Microsoft Access records.
          Do While Not rst.EOF
            If rst!AddedToOutlook = True Then
            rst.MoveNext
            End If
            Dim objOutlook As Outlook.Application
            Dim objAppt As Outlook.AppointmentItem
            Dim objRecurPattern As Outlook.RecurrencePattern
    
            Set objOutlook = CreateObject("Outlook.Application")
            Set objAppt = objOutlook.CreateItem(olAppointmentItem)
    
            With objAppt
               .Start = rst!ApptDate & " " & rst!ApptTime
                   .Duration = rst!ApptLength
                   .Subject = rst!Appt
                   If Not IsNull(rst!ApptNotes) Then .Body = rst!ApptNotes
                   If Not IsNull(rst!ApptLocation) Then .Location = rst!ApptLocation
                .ReminderMinutesBeforeStart = 0
                .ReminderSet = False
            
                .Save
                .Close (olSave)
                End With
                'Release the AppointmentItem object variable.
                Set objAppt = Nothing
    
        'Release the Outlook object variable.
        Set objOutlook = Nothing
             'Next Record
             .MoveNext
          Loop
          MsgBox "Appointments Added"
          DoCmd.OpenQuery "Update Added Appointments"
       End With
        Exit Sub
    
    Add_Err:
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Exit Sub
    End Sub

  2. #2
    Join Date
    May 2005
    Location
    Nevada, USA
    Posts
    2,888
    Provided Answers: 6
    Well, this code:

    Code:
    If rst!AddedToOutlook = True Then
      rst.MoveNext
    End If
    will skip that record, but then proceed to add the next no matter what. To stay with how you're doing it I'd reverse it and do something like this:

    Code:
    If rst!AddedToOutlook = False Then
      'all your code to add
    End If
    
    rst.MoveNext
    But what I would do is change this line:

    Set rst = CurrentDb.OpenRecordset("tblAppointments")

    to use an SQL statement instead of opening the whole table. That statement would only pull records that needed to be added, so you could eliminate the test altogether. That would be much more efficient than opening the recordset on the whole table.
    Paul

  3. #3
    Join Date
    Mar 2009
    Posts
    5
    Hi,

    Cheers for the advice. I have used a SQL statement, which seems to work until there are no records found. Below is a sample of the new code at the top.

    Code:
     DoCmd.OpenQuery "Append 5 Day Forecast"
    sSQL = "SELECT tblAppointments.apptID, tblAppointments.Appt, tblAppointments.ApptDate, tblAppointments.ApptTime, tblAppointments.ApptLength, tblAppointments.ApptNotes, tblAppointments.ApptLocation, tblAppointments.ApptReminder, tblAppointments.ReminderMinutes, tblAppointments.AddedToOutlook FROM tblAppointments WHERE (((tblAppointments.AddedToOutlook)=False))"
    'Set rst = CurrentDb.OpenRecordset("tblAppointments")
    Set rst = CurrentDb.OpenRecordset(sSQL)
    
       With rst
          .MoveFirst
          ' Loop through the Microsoft Access records.
          Do While Not rst.EOF
            Dim objOutlook As Outlook.Application
            Dim objAppt As Outlook.AppointmentItem
            Dim objRecurPattern As Outlook.RecurrencePattern
    
            Set objOutlook = CreateObject("Outlook.Application")
            Set objAppt = objOutlook.CreateItem(olAppointmentItem)
    The line it is showing yellow on is ".MoveFirst" . I am guessing this is because it cannot start the loop process.

  4. #4
    Join Date
    May 2005
    Location
    Nevada, USA
    Posts
    2,888
    Provided Answers: 6
    Drop that line. It isn't necessary, as the recordset will start at the first record anyway, and as you've found it will error when there are no records.
    Paul

  5. #5
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    you may need to test for .bof and .eof. i forget how a recordset behaves if there are now rows in it and you issue a .movefirst
    if both are true then theres no records in the recordset
    if bof is not true then you are not at the beginning of the recordset

    so your processing might be
    Code:
    with rst
     if .bof and .eof <> true 'then we have stuff to do
        while .eof =false 'keep in this loop until we reach EOF.
          'do some stuff
        wend 'we get here while iterating through the recordset
      'else 'insert some error reporting (optional on no rows returned
      endif
    end with
    I'd rather be riding on the Tiger 800 or the Norton

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •