Adding multiple attachments from access into outlook

I have traveled the world and the seven seas and I have yet to come up with an answer to this question....
So I'm adding an attachment to an email from access...
The following is the code:

stSQL = "SELECT * FROM AddedToOutlook WHERE DatabaseReferenceNumber = " _
& recSet1("DatabaseReferenceNumber2")

recSet6.Open stSQL, con6, adOpenKeyset, adLockOptimistic
If recSet6.EOF Then
recSet6.AddNew

Dim objOutlookRecip As Outlook.Recipient
Dim outObj As Outlook.Application
'Dim outItem As Outlook.ContactItem
Dim outAppt As Outlook.AppointmentItem
Dim outOutlookAttach As Outlook.Attachment
'Set outItem = outObj.CreateItem(olContactItem)
Set outObj = CreateObject("outlook.application")
Set outAppt = outObj.CreateItem(olAppointmentItem)
With recSet8
.AddNew
.Fields("Start") = recSet1.Fields("NotificationDate2") _
& " " & recSet1.Fields("ApptTime2")
.Fields("Subject") = "Contract Notification/End" & " " _
& recSet1.Fields("DatabaseReferenceNumber2") _
& " " & recSet1.Fields("Vendor2")
.Fields("Body") = "Contract Notification/End" & " " _
& recSet1.Fields("DatabaseReferenceNumber2") _
& " " & recSet1.Fields("Vendor2")
.Fields("ReminderMinutesBeforeStart") = recSet1.Fields("ReminderMinutes2")
.Update
End With
With outAppt
.Start = recSet1.Fields("NotificationDate2") _
& " " & recSet1.Fields("ApptTime2")
.Duration = .AllDayEvent
.Subject = "Contract Notification/End" & " " _
& recSet1.Fields("DatabaseReferenceNumber2") _
& " " & recSet1.Fields("Vendor2")
.Body = "Contract Notification/End" & " " _
& recSet1.Fields("DatabaseReferenceNumber2") _
& " " & recSet1.Fields("Vendor2")
.ReminderMinutesBeforeStart = recSet1.Fields("ReminderMinutes2")
.ReminderSet = True
.RequiredAttendees = "JPollard@phcs.com"
.Save
End With

'DoCmd.RunCommand acCmdSaveRecord
recSet6.Fields("AddedToOutlook") = True
recSet6.Fields("DatabaseReferenceNumber") = recSet1.Fields("DatabaseReferenceNumber2")
recSet6.Update
End If

recSet6.Close
'MsgBox "All done...", vbMsgBoxSetForeground

and from here I go to the end (because the other part is in an If statement and that's in a loop...once the loop's finished, I've gathered the necessary information I would paste the full function but I already have in another place on this site and it is not pertinent to this question because it works...The problem is arising here:

' Send a message to your new contact.
Dim outMail As Outlook.MailItem
Set outMail = outObj.CreateItem(olMailItem)
' Fill out & send message...
outMail.To = recSet8.Fields("RequiredAttendees")
outMail.Subject = "Contract Notification/End..."
recSet8.MoveFirst
Do Until recSet8.EOF
outAppt.Start = recSet8.Fields("Start")
outAppt.Duration = 15
outAppt.Subject = recSet8.Fields("Subject")
outAppt.Body = recSet8.Fields("Body")
outAppt.ReminderMinutesBeforeStart = recSet8.Fields("ReminderMinutesBeforeStart")
outAppt.ReminderSet = True
outAppt.RequiredAttendees = recSet8.Fields("RequiredAttendees")
Set outOutlookAttach = outMail.Attachments.Add(outAppt)
recSet8.MoveNext
Loop
outMail.Body = _
"HI"
outMail.Send

recSet8, as you can see from the beginning code, is where I save all the necessary information...so I have this outOutlookAttach which I declared as an attachment (perhaps I need to declare as attachments but I could get that to work either) anyways I have it go through this loop but instead of returning the five results that it should (since there are five results in the table for this particular program at this point in time...but this number varies) it returns the last result in the email...but 5 times....which doesn't seem to make sense since if it is adding something every time, I should get an email with five different appointments or at least an email with just the last appointment....Can anyone understand what's going on here and how I can add multiple attachments from Access into Outlook? Your help would be greatly appreciated.