Send e-mail from Access with multiple Attachements

[Dave]

I am trying to send an email with several attachments using VBA

The code is searching a directory for file names using wildcards and attaching the files it finds to the e-mail
When it does not find anything is gives an msgbox stating that there are no attachments to send

Here is my problem...When the code searches for a file name and attaches it attaches an additional copy of one of the files. I have pasted in the code I am using. Any help would be greatly appreciated

I think the problem is in the Set command after the loop

Thank you very much

Option Compare Databas

Public Function Send_Mail(
On Error GoTo Error_Handle

Dim objOutlook As Outlook.Applicatio
Dim objEmail As Outlook.MailIte
Dim objOutlookRecip As Outlook.Recipien

Set objOutlook = CreateObject("Outlook.application"
Set objEmail = objOutlook.CreateItem(olMailItem

With objEmai
Set objOutlookRecip = .Recipients.Add("(e-mail address removed)"
objOutlookRecip.Type = olBC

.Subject = "Confirmation of files received
.Body = "

Filname = Dir("\\david\c\documents and settings\dave\desktop\TMG WIP\ws_ftp*.*"
Do Until Filname = "
fileName = ("\\david\c\documents and settings\dave\desktop\TMG WIP\" & Filname

Filname = Dir(

Set objOutlookAttach = .Attachments.Add(fileName


Loo

If Not IsMissing(fileName) The
Set objOutlookAttach = .Attachments.Add(fileName
End I

.sen


End Wit

Exit_Here
Set objOutlook = Nothin
Exit Functio

Error_Handler
MsgBox "THERE ARE NO ATTACHMENTS TO SEND!
Resume Exit_Her

End Functio

 

[Cheryl Fischer]

Maybe a tiny bit too much code ... Give the following (untested air-code)
a try

With objEmail
Set objOutlookRecip =
..Recipients.Add("(e-mail address removed)")
objOutlookRecip.Type = olBCC

.Subject = "Confirmation of files received"
.Body = " "

Filname = Dir("\\david\c\documents and settings\dave\desktop\TMG
WIP\ws_ftp*.*")
Do Until Filname = ""
fileName = ("\\david\c\documents and settings\dave\desktop\TMG
WIP\" & Filname)
Filname = Dir()
If Len(Trim(fileName)) > 0 then
.Attachments.Add fileName
End If
Loop

' Comment out the next 3 lines
'If Not IsMissing(fileName) Then
'Set objOutlookAttach = .Attachments.Add (fileName)
'End If

.Send
End With


hth,
--

Cheryl Fischer, MVP Microsoft Access
Law/Sys Associates, Houston, TX

I am trying to send an email with several attachments using VBA.

The code is searching a directory for file names using wildcards and

attaching the files it finds to the e-mail.

When it does not find anything is gives an msgbox stating that there are no attachments to send.

Here is my problem...When the code searches for a file name and attaches

it attaches an additional copy of one of the files. I have pasted in the
code I am using. Any help would be greatly appreciated.