Problems with Record Selection

[rnutts]

I have posted a couple of times about a loop I am trying to create to populate Outlook appointments, the loop is working but my record selection is not.
I have posted the whole code below, but have highlighted the bits that are causing problems
The purpose of the code is to create an appointment on Outlook with various bits of info from the Job creation for, for each person allocated to the job. My problem is that my code selects the number of relevant records, but when I try to specify employees name using dlookup I am struggling with the Criteria to tie it up to the records I have selected.

All comments are welcome

Private Sub btnAddApptToOutlook_Click()
'On Error GoTo ErrHandle

Dim olNS As Object
Dim olApptFldr As Object
Dim startid As String
Dim endid As String
Dim firstsubjob As String
Dim lastsubjob As String


startid = 1
endid = DCount("Jobnumber", "tblemployeesonjob", "jobnumber=" & Me.JobNumber)
firstsubjob = 1
lastsubjob = DCount("RemJobNo", "tblassistenvsubjobs", "remjobno=" & Me.JobNumber)

' Save the Current Record
If Me.Dirty Then Me.Dirty = False

' Exit the procedure if appointment has been added to Outlook.
If Me.ApptAdded = True Then
MsgBox "This appointment has already been added to Microsoft Outlook.", vbCritical
Exit Sub
Else

' Use late binding to avoid the "Reference" issue
Dim olApp As Object 'Outlook.Application
Dim olAppt As Object 'olAppointmentItem

'This is how we would do it if we were using "early binding":
' Dim olApp As Outlook.Application
' Dim olappt As Outlook.AppointmentItem
' Set olapp = CreateObject("Outlook.Application")
' Set olappt = olapp.CreateItem(olAppointmentItem)

If IsAppThere("Outlook.Application") = False Then
' Outlook is not open, create a new instance
Set olApp = CreateObject("Outlook.Application")
Else
' Outlook is already open--use this method
Set olApp = GetObject(, "Outlook.Application")
End If
For a_counter = startid To endid
Set olAppt = olApp.CreateItem(1) ' 1 = olAppointmentItem

' Add the Form data to the Appointment Properties
With olAppt
If Nz(Me.chkalldayevent) = True Then
.Alldayevent = True

' Format the dates in the Form Controls
Me.txtStartDate = FormatDateTime(Me.txtStartDate, vbShortDate)
Me.txtEndDate = FormatDateTime(Me.txtEndDate, vbShortDate)
' For all day events use "" for the start time and the end time
Me.cboStartTime = ""
Me.cboEndTime = ""

' Get the Start and the End Dates
Dim dteTempEnd As Date
Dim dteStartDate As Date
Dim dteEndDate As Date
dteStartDate = CDate(FormatDateTime(Me.txtStartDate, vbShortDate)) ' Begining Date of appointment
dteTempEnd = CDate(FormatDateTime(Me.txtEndDate, vbShortDate)) ' Use to compute End Date of appointment

' Add one day to dteEndDate so Outlook will set the number of days correctly
dteEndDate = DateSerial(Year(dteTempEnd + 1), Month(dteTempEnd + 1), Day(dteTempEnd + 1))

.Start = dteStartDate
.End = dteEndDate

' Set the number of minutes for each day in the AllDayEvent Appointment
Dim lngMinutes As Long

lngMinutes = CDate(Nz(dteEndDate)) - CDate(Nz(dteStartDate))
' The duration in Minutes, 1440 per day
lngMinutes = lngMinutes * 1440

' Add the minutes to the Access Form
Me.txtApptLength.Value = lngMinutes

.Duration = lngMinutes

Else

' The Validation Rule for the Start Date TextBox requires a
' Start Date so there is no need to check for it here
If Len(Me.cboStartTime & vbNullString) = 0 Then
' There is no end time on the Form
' Add vbNullString ("") to avoid an error
Me.cboStartTime = vbNullString
End If

' Set the Start Property Value
.Start = FormatDateTime(Me.txtStartDate, vbShortDate) _
& " " & FormatDateTime(Me.cboStartTime, vbShortTime)

' If there is no End Date on the Form just skip it
If Len(Me.txtEndDate & vbNullString) > 0 Then
If Len(Me.cboEndTime & vbNullString) = 0 Then
' There is no end time on the Form
' Add vbNullString ("") to avoid an error
Me.cboEndTime = vbNullString
Else
' Set the End Property Value
.End = FormatDateTime(Me.txtEndDate, vbShortDate) _
& " " & FormatDateTime(Me.cboEndTime, vbShortTime)
End If
End If

If Len(Me.txtApptLength & vbNullString) = 0 Then
Dim timStartTime As Date
Dim timEndTime As Date

' Format the Start Time and End Time
timStartTime = FormatDateTime(Me.txtStartDate, vbShortDate) _
& " " & FormatDateTime(Me.cboStartTime, vbShortTime)
timEndTime = FormatDateTime(Me.txtEndDate, vbShortDate) _
& " " & FormatDateTime(Me.cboEndTime, vbShortTime)

.Duration = Me.txtApptLength
End If
End If

If Nz(Me.chkalldayevent) = False Then
.Alldayevent = False
End If

If Len(Me.SurveyorNo.Column(1) & Me.worktype & vbNullString) > 0 Then
.Subject = Me.EnqNumber & "---" & Me.JobNumber & "---" & DLookup("employeename", "tblemployeesonjob") & "---" & Me.worktype
End If

If Len(Me.JobNumber & vbNullString) > 0 Then
.Body = Me.JobNumber
End If

If Len(Me.siteref.Column(2) & vbNullString) > 0 Then
.Location = Me.Client.Column(0) & "---" & Me.siteref.Column(2)
End If

.ReminderSet = False

' Save the Appointment Item Properties
.Save

End With
Next a_counter
' Set chkAddedToOutlook to checked
Me.chkAddedToOutlook = True

' Save the Current Record because we checked chkAddedToOutlook
If Me.Dirty Then Me.Dirty = False

' Inform the user
MsgBox "New Outlook Appointment Has Been Added!", vbInformation
End If

ExitHere:
' Release Memory
Set olApptFldr = Nothing
Set olNS = Nothing
Set olAppt = Nothing
Set olApp = Nothing
Exit Sub

ErrHandle:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
& vbCrLf & "In procedure btnAddApptToOutlook_Click in Module Module1"
Resume ExitHere

End Sub


Many thanks

Richard

 

[jdraw]

May not have anything to do with your issue, but you have Dimmed startid and endid as String and you have assigned an integer to startid, and I suspect Dcount will return a number.

Do you get any specific error message?

 

[vbaInet]

Please no need to post several times, follow-up your original thread if the questions are related. See responses in your original thread:

http://www.access-programmers.co.uk/forums/showthread.php?p=1132241#post1132241