problem with outlook automation routine...

T

TC

At a quick glance, it looks ok to me.

Try putting these two lines immediately after the OpenRecordset statement.
They display the total number of recvords in the recordset. If that is zero,
.... :)
Set MySet = MyDB.OpenRecordset("emailattachments", DB_OPEN_DYNASET)
Click to expand...
MySet.movelast
msgbox MySet.recordcount

HTH,
TC
 
V

Vanessa_S

I'm trying to create a VBA routine that allows me to send
multiple attachments in one e-mail. The full path
information of each attachment is stored into one table
named emailattachments. I'm iterating through the table
but for some reason only 1 attachment is picked up.
Does anyone see what I'm doing wrong here.
Thanks.


Dim MyDB As Database, MySet As Recordset
Dim strMsg As String
Dim retval As Integer
Dim stremailto As String
Dim qdf As QueryDef
Dim prm As Parameter
Dim pathattachment As String

Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set MySet = MyDB.OpenRecordset("emailattachments",
DB_OPEN_DYNASET)

'On Error GoTo Send_Err

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Set objOutlook = CreateObject("Outlook.Application")

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With MySet
.MoveFirst
Do While Not .EOF
With objOutlookMsg
.To = "[email protected]"
.Subject = "Automated Message: INCOMING REQUEST"
.Body = Nz("Double-Click to Open attachment(s)...")
.Attachments.Add (MySet!fldfullpathattachment)
.Recipients.ResolveAll
.Send
End With
.MoveNext
Loop
.Close
End With

DoCmd.Hourglass False
Set objOutlook = Nothing

'GoTo Send_End

'Send_Err:
' MsgBox ("The message to " & stremailto & " could not
be sent. The name may not exist in Outlook or may not be
unique. Click on OK to open the message, then click on
the 'Check names' button and select a recipient or close
the message.")
' objOutlookMsg.Display

'Send_End:
' DoCmd.Hourglass 0
 
T

TC

On what line did you get that error?

Are you sure that the code you are running, is what you've actually shown us
here?

If the msgbox showed that the recordset has 2 records, the next thing I
would do is to temporarily remove eveything from 'With objOutlookMsg' to the
corresponding 'End With'. Put a msgbox in it's place. Then you can see the
loop execute, record by record, without any confusion from the outlopok
stuff. It shouldn't be too hard to see what is actuaklly hapenning, then.

HTH,
TC
 
V

Vanessa_S

I have done this, displayed '2' in msgbox.
It is still putting only 1 attachment in the email.
I also received the following error message:

Run time error.
The item has been moved or deleted.
 
D

Dan Artuso

HI,
The only code you want inside your recordset loop is the code that
adds the attachments.
As it is, you're sending an email for every attachment.
 
V

Vanessa_S

I have slightly modified my routine and it works now.
See below:


Dim MyDB As Database, MySet As Recordset
Dim strMsg As String
Dim retval As Integer
Dim stremailto As String
Dim qdf As QueryDef
Dim prm As Parameter

Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set MySet = MyDB.OpenRecordset("emailattachments",
DB_OPEN_DYNASET)

On Error GoTo Send_Err

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Set objOutlook = CreateObject("Outlook.Application")

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

objOutlookMsg.Body = "Double-Click to Open attachment..."
objOutlookMsg.Subject = "Incoming Request..."
objOutlookMsg.To = "[email protected]"

With MySet
.MoveFirst
Do While Not .EOF

With objOutlookMsg.Attachments
.Add (MySet!fldfullpathattachment)
End With

.MoveNext
Loop
.Close
End With

objOutlookMsg.Send


DoCmd.Hourglass False
Set objOutlook = Nothing

GoTo Send_End

Send_Err:
MsgBox ("The message to " & stremailto & " could not
be sent. The name may not exist in Outlook or may not be
unique. Click on OK to open the message, then click on
the 'Check names' button and select a recipient or close
the message.")
objOutlookMsg.Display

Send_End:
DoCmd.Hourglass 0
 
Top