sending attachment proplem

[scorpion1966]

I am trying to send an emails by access and the code seems to work fine but i can not send an attachment please can anyone help me!! here is my code below i think its ok.

Public Function SendMessages(Optional AttachmentPath)

Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String

Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblMailingList")
MyRS.MoveFirst

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

Do Until MyRS.EOF
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = MyRS![EmailAddress]

With objOutlookMsg
' Add the To recipients to the e-mail message.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo

' Add the Cc recipients to the e-mail message.
If (IsNull(Forms!frmMail!CCAddress)) Then
Else
Set objOutlookRecip = .Recipients.Add(Forms!frmMail!CCAddress)
objOutlookRecip.Type = olCC
End If

' Set the Subject, the Body, and the Importance of the e-mail message.
.Subject = Forms!frmMail!Subject
.Body = Forms!frmMail!MainText
.Importance = olImportanceHigh 'High importance

'Add the attachment to the e-mail message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If

' Resolve the name of each Recipient.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
MyRS.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Function