VB Script to Send Multiple Attachments via Email

[dwcolt]

Help! I'm hoping that someone can point me to a VB script that will do a fairly simple task.

I have a Microsoft Access table that lists the full directory path for a number of files.

I am looking for a script that will create a new email message in Outlook that attaches each of the files listed in the table. The user will then input the recipient and subject, and can send the email from Outlook.

Any help would be greatly appreciated! Thanks in advance.

[dwcolt]

Loop not working

Ok, I've written some code that mostly works, but here's the problem: I have 3 files that come up in the query below. I want the code to insert those 3 files into the email as attachments. The code is inserting the first file 3 times, instead or inserting each of the 3 files. What am I doing wrong with my loop?

Private Sub EmailMarkedDocu ments_Click()
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Applica tion
Dim objOutlookMsg As Outlook.MailIte m
Dim objOutlookAttac h As Outlook.Attachm ent
Dim TheAttachment As String

Me.CourtClipRes ults.Requery
If (DCount("[Description]", "CheckForMarked Query") < 1) Then
MsgBox "You must check at least one document in order to send the email.", 0, "CW Case Management System"
Else

Set objOutlook = CreateObject("O utlook.Applicat ion")
Set objOutlookMsg = objOutlook.Crea teItem(0) 'olMailItem
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecord set("CheckForMa rkedQuery")
TheAttachment = MyRS![FilePath]
MyRS.MoveFirst

With objOutlookMsg

.Subject = "Documents from Colt / Wallerstein LLP for Matter: " & (DLookup("[MatterName]", "MatterList ", "ID=Forms!Court ClipForm!CourtC lipMatter"))
.HTMLBody = "Please see the attached documents."


Do Until MyRS.EOF
MyRS.MoveNext
Set objOutlookAttac h = .Attachments.Ad d(TheAttachment )

Loop
End With

objOutlookMsg.D isplay

End If

End Sub