Loop Help

rnutts

Registered User.
Local time
Today, 19:52
Joined
Jun 26, 2007
Messages
110
Hi

I have a form for creating jobs with a subform allowing employees to be allocated to the job. the main form captures appointment times, dates duration etc. I have some vba code which will put the appointments into Outlook, however I have been asked to expand on this and create an appointment in Outlook for each employee allocated to a job. Following some research I believe I need to use a loop to repeat certain bits of the appointment creation code.
I have created some test code which is below. In my test there are three employees allocated to the job and I do received the msgbox 3 times but on each msgbox I get the [id] for the first record out of the three records.
Could someone please tell me if I am using the correct loop and if so what is wrong with the code or if I am using the wrong type of loop, which one I should be using.

Private Sub Command102_Click()
On Error GoTo Err_Command102_Click
For a_counter = DMin("id", "tblemployeesonjob", "jobnumber = " & Me.JobNumber) To DMax("id", "tblemployeesonjob", "jobnumber=" & Me.JobNumber)
MsgBox "hallo" & Me.frmEmployeesOnJob.Form.ID, vbOKOnly
Next a_counter

Exit_Command102_Click:
Exit Sub
Err_Command102_Click:
MsgBox Err.Description
Resume Exit_Command102_Click

End Sub


Thanks

Richard
 
Code:
Private Sub Command102_Click()

For a_counter = DMin("id", "tblemployeesonjob", "jobnumber = " & Me.JobNumber) To   DMax("id", "tblemployeesonjob", "jobnumber=" & Me.JobNumber)

  [b]MsgBox "hallo" & Me.frmEmployeesOnJob.Form.ID, vbOKOnly[/b]

Next a_counter

You never do anything to change the value here.
 
You first of all need a query that will pull the DISTINCT IDs of those Employees allocated to a job. Now I'm guessing the table tblemployeesonjob does this but if this is a many-to-one mapping with your Employees table then you want DISTINCT IDs.

Secondly, you need to loop through a recordset:. Here's some aircode
Code:
dim rs as dao.recordset

set rs = currentdb.openrecordset("[COLOR=Red]SELECT ID FROM tblemployeesonjob[/COLOR];", dbOpenSnapshot)

do while not rs.eof
    ... do whatever you want with rs![COLOR=Red]ID [/COLOR]here ...
    rs.movenext
loop

rs.close
set rs = nothing
Amend the red bit if necessary.

Looping through DMin() and DMax() won't work because you don't know if the numbers within exist or missing.

Edit: More on recordsets here:

http://allenbrowne.com/ser-29.html
 
This was me trying to get to the bottom of my problem with what knowledge I had. The other post I had running was because I thought I had moved onto what was effectively another problem(although it wasnt) and I thought people would view this as a dead post.
Any how thanks for your response, will give it a go and report back

Thanks

Richard
 
If we come across a post that we think hasn't been resolved we would chime in. ;)

Let us know how you get on.
 
Not getting on well as I have no understanding of what I am doing
So in an attempt to get some more help, I have created a query called qrytest which does what I want in pulling the relevant information I need
I have posted the sql to this query below

SELECT tblEmployeesOnJob.ID, tblEmployeesOnJob.JobNumber, tblEmployeesOnJob.EmployeeName
FROM tblEmployeesOnJob
WHERE (((tblEmployeesOnJob.JobNumber)=[Forms]![frmnapswork]![jobnumber]));

Now I want to run my loop based upon the information from the select query above.
I am trying to get my head round how to do this as with everything understanding is better than parrot fashion
Can you please try and point me in the way to do this. The code I want to loop through is in my other post, if that is any more help.

Many thanks

Richard
 
The code I gave you in post #3 will loop through the query. Have you given it a shot?
 
I did give it a shot
I get 10 appointments in Outlook, when I looking with my example for only one appointment.
The reason for 10 appointments is there are 10 records currently in tblemployees on job. I need to be able to have a WHERE clause something similar to dlookup("jobnumber","tblemployeesonjob","jobnumber = " & me.jobnumber)

I hope you understand

Thanks

Richard
 
I need to be able to have a WHERE clause something similar to dlookup("jobnumber","tblemployeesonjob","jobnumber = " & me.jobnumber)
You're not following what I'm saying. How else would you get the JobNumber if you don't loop through something? I gave you the code that will loop through the query to loop through and for each record create an appointment.
 
Ok, have read your post 3 very slowly and now is this what you meant all along

1 Within the code create a query, something along the lines of

Dim strsql as string

strsql = select **** from**** where****=**** (as appropriate)

then
dim rs as dao.recordset

set rs = currentdb.openrecordset("SELECT ID FROM tblemployeesonjob;", dbOpenSnapshot) not quite sure what the red should be, have tried strsql but get error message from access

do while not rs.eof

then my appointment code

rs.movenext
loop

rs.close
set rs = nothing

Please tell me I am getting close.
thanks for the patience

Richard
 
You're on the ball.

The red part will be your strSQL.
 
Ok so now I have the button working and it is creating appointments for each person allocated to the job, however I am getting the same persons name for each appointment, the one with the lowest employeeid

I am currently using the following code to get the employees name. I need to link this to the recordset (each recordset has a different employeename within it), I have called using a query earlier on in the code.This code is in the middle of the loop. I will also post the whole of the appointment code and highlight where my problem is.
I have tried rs.employeename, but this gives me problems referencing any me.fieldnames I try to use elsewhere.

Any and all help greatly appreciated

Problem Piece of code

If Len(Me.SurveyorNo.Column(1) & Me.worktype & vbNullString) > 0 Then
.Subject = Me.frmEmployeesOnJob!EmployeeName
End If

Whole Code


Private Sub btnAddApptToOutlook_Click()
'On Error GoTo ErrHandle

Dim olNS As Object
Dim olApptFldr As Object
Dim strsql As String

strsql = "SELECT tblemployeesonjob.[id], tblemployeesonjob.[employeeName], tblemployeesonjob.[jobnumber] " & _
"FROM tblemployeesonjob " & _
"WHERE (((tblemployeesonjob.[jobnumber]) = " & [Forms]![frmnapswork]![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
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset(strsql)
Do While Not rs.EOF
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.frmEmployeesOnJob!EmployeeName
End If

If Len(Me.JobNumber & vbNullString) > 0 Then
.Body = Me.EnqNumber & "---" & 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
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
' 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
 
Thanks again, like I said I had tried rs. and had completely missed you had said rs! in your original post.
As you already know it works like a dream now

Once again

thanks

Richard
 
Glad to hear Richard.

Just fyi, you can use the dot with rs in this way, rs.Fields("FieldName")
 
Ok now that I have managed, with a lot of help, got the appointments working, my boss wants more

We create appointments within outlook using the code above and running a loop, however we have also subjobs linked to the main job and within the 'body' of the appointment he wants a summary of all the various sub jobs something like this

subjob1 bathroom floortiles
subjob2 something else
Subjob 3 else something

I thought that creating a loop within the loop would do this but the code just returns the last subjob in the loop see below

Code:
Set rs2 = CurrentDb.OpenRecordset(strsql2)
             Do While Not rs2.EOF
            
                If Len(Me.JobNumber & vbNullString) > 0 Then
                 .body = rs2!RemRoom & " " & rs2!RemItemLoc & " " & rs2!RemItem
                End If
             rs2.MoveNext
             Loop
             rs2.Close
             Set rs2 = Nothing[\code]
 
I tried an if statement that was something like this
 
[code]if remsubjobno =1 then
line 1 = rs2!RemRoom & " " etc
End If
IF remsubjobno = 2 then
line 2 = rs2!RemRoom
End If
rs2.movenext
loop
.body= line 1 & vbcrlf & line 2
rs2.close
setrs2=nothing[\code]
 
So what I am looking for is to run a loop and for each time the loop is run then a variable is stored so I can use them to create a string when the loop has finished running
 
Many Thanks
 
You always get ahead of yourself. Get the second loop working first before you try to integrate it into your code. Use the FindFirst method to filter the second loop for each time the first loop runs, then loop through the second loop to get the subjobs.
 
Have managed to get working using an array, the code for which I found on the internet and have adapted to get what I want.
It may not be pretty but it works see below

Code:
Set rst = CurrentDb.OpenRecordset(strsql2)
             rst.MoveFirst
            
                If Len(Me.JobNumber & vbNullString) > 0 Then
                For intcounter = DMin("RemSubJobNo", "tblAssistEnvSubJobs", "RemJobNo=" & Me.JobNumber) To DMax("RemSubJobNo", "tblAssistEnvSubJobs", "RemJobNo=" & Me.JobNumber)
                                arrcount(intcounter) = rst!RemSubJobNo & "---" & rst!RemRoom & " ---" & rst!RemItemLoc
                rst.MoveNext
            Next intcounter
            line1 = arrcount(1) & vbCrLf & arrcount(2) & vbCrLf & arrcount(3) & vbCrLf & arrcount(4) & vbCrLf & arrcount(5) & vbCrLf & arrcount(6) & vbCrLf & arrcount(7) & vbCrLf & arrcount(8) & vbCrLf & arrcount(9) & vbCrLf & arrcount(10)
            .body = line1
            End If[\Code]
 
Thanks
 
Richard
 
I can't believe that after 15 posts you've still gone back to using the DMin and DMax functions as your benchmark
 
Ok so the taunt worked and I read further into the article where I got the code and have changed as follows.
I still presume it could be preetier but at least the taunt took me out of my comfort zone

Code:
Set rst = CurrentDb.OpenRecordset(strsql2)
             rst.MoveLast
             rst.MoveFirst
             intupbound = rst.RecordCount
            
                If Len(Me.JobNumber & vbNullString) > 0 Then
                For intcounter = 1 To intupbound
                                arrcount(intcounter) = rst!RemSubJobNo & "---" & rst!RemRoom & " ---" & rst!RemItemLoc
                rst.MoveNext
            Next intcounter
            line1 = arrcount(1) & vbCrLf & arrcount(2) & vbCrLf & arrcount(3) & vbCrLf & arrcount(4) & vbCrLf & arrcount(5) & vbCrLf & arrcount(6) & vbCrLf & arrcount(7) & vbCrLf & arrcount(8) & vbCrLf & arrcount(9) & vbCrLf & arrcount(10)
            .body = line1
            End If[\code]
 
let me know your thoughts - I am fragile so please be gentle
 
Richard
 
Only joking, enjoying the challenges
 

Users who are viewing this thread

Back
Top Bottom