How to add CC and be able to attach multiple excel files in MS Access 2000 & Outlook

[bee]

I am currently using the code pasted below to attach multiple attachments to multiple recipients. It is currently working. I am just having problems adding CCs. Is there any way that this code can be modified to allow me to add CCs. I was able to find a code that could attach CCs but it can only allow me to add one recipient and one attachment. Your help will greatly be appreciated. Thanks :) Oh, I'm currently doing this using MS Access 2000.

Public Sub SendMultiple(ByVal aSubject As String, ByVal aRecipients As String, _
Optional ByVal aBody As String = "", Optional ByVal aAttachments As String = "", _
Optional ByVal aRootPath As String = "")

Dim myO As Outlook.Application
Dim mobjNewMessage As Outlook.MailItem
Dim sRecipient, sAttachment, sDisplayName As String
Dim iMarker, iMarker2 As Integer

On Error GoTo Error_SendEMail
Set myO = CreateObject("Outlook.Application")
Set mobjNewMessage = myO.CreateItem(olMailItem)
mobjNewMessage.Subject = aSubject
mobjNewMessage.Body = aBody
' Loop through ; separated recipients
Do
iMarker = InStr(1, aRecipients, ";", vbTextCompare)
If iMarker = 0 Then
sRecipient = aRecipients
Else
sRecipient = Mid(aRecipients, 1, iMarker - 1)
aRecipients = Mid(aRecipients, iMarker + 1)
End If
If Len(sRecipient) <> 0 Then mobjNewMessage.Recipients.Add sRecipient
Loop While iMarker <> 0

' Loop through ; separated attachments - also look for ***DisplayName
Do
iMarker = InStr(1, aAttachments, ";", vbTextCompare)
If iMarker = 0 Then
sAttachment = aAttachments
Else
sAttachment = Mid(aAttachments, 1, iMarker - 1)
aAttachments = Mid(aAttachments, iMarker + 1)
End If
If Len(sAttachment) <> 0 Then
' Is there an embedded display name?
iMarker2 = InStr(1, sAttachment, "***", vbTextCompare)
If iMarker2 <> 0 Then
sDisplayName = Mid(sAttachment, iMarker2 + 3)
sAttachment = aRootPath + Mid(sAttachment, 1, iMarker2 - 1)
If StrComp(Dir(sAttachment), "", vbTextCompare) <> 0 Then _
mobjNewMessage.Attachments.Add sAttachment, , , sDisplayName
Else
If StrComp(Dir(aRootPath + sAttachment), "", vbTextCompare) <> _
0 Then mobjNewMessage.Attachments.Add aRootPath + sAttachment
End If
End If
Loop While iMarker <> 0

' Send the message
mobjNewMessage.Display

Exit_SendEMail:

Set mobjNewMessage = Nothing
Set myO = Nothing
Exit Sub

Error_SendEMail:
MsgBox Err.Description, , "Send Mail Error"
Resume Exit_SendEMail
End Sub

Edit: Switched Code Tag to VBA Tag. Split long lines of code @ 80 chars to prevent side-scrolling.
~Oorang