Email through Access with Multiple Attachments picked from TBL 1

[Flo79]

Hi There!

I have a form from which to send emails in Access

I am trying to include a subfrom. The subform holds the file paths of one or multiple attachments, which I would like to include in my email.

I am trying to write code which loops through each record in this subform and includes each specified file in the email to be send. I am having a hard time doing this as my VB skills are more trial and error than effective programming.

Here is the code (which makes my application freeze for unknown reasons to me)

Maybe one of you can tell me why...


--------------------------------------------------------

Dim App As Outlook.Application
Dim Message As Outlook.MailItem

Set App = CreateObject("Outlook.Application")
Set Message = App.CreateItem(olMailItem)

With Message

.To = rst(EmailAddressField)
.Importance = olImportanceHigh
.SentOnBehalfOfName = "Email@email.com"
.subject = Me.Controls(MsgSubjectField)
.Body = strMsgToSend

End With

' Here is where the Problem lies:


Dim rs As DAO.Recordset

Dim F As Form
Set F = CodeContextObject
Set rs = F!Sub_Attachments.RecordsetClone

Do Until rs.BOF

With Message
.Attachments.Add rs!File_Path
End With
rs.MoveNext
Loop

With Message
.Save

End With

Set App = Nothing
Set Message = Nothing

--------------------------------------------------------

 

[Flo79]

I made a few adjustments to my code, it now works partially.

The problem is that the attachments listed in my subform are only included in my email after I have closed and opened my form again.

After I run my code once, attachments are omitted.

Only when I close and open the form again, does the email include attachments. I am clueless why that happens.

I tried refeshing the form/subform as wel as requery. Nothing helps

Nay ideas would be greatly appreciated

----------------------------

Dim App As Outlook.Application
Dim Message As Outlook.MailItem
Dim rs As DAO.Recordset


Set App = CreateObject("Outlook.Application")
Set Message = App.CreateItem(olMailItem)

With Message

.To = rst(EmailAddressField)
.Importance = olImportanceHigh
.SentOnBehalfOfName = "test@test.com"
.subject = Me.Controls(MsgSubjectField)
.Body = strMsgToSend

End With


Set rs = Forms!Email_Compose!Sub_Attachments.Form.RecordsetClone
Do Until rs.EOF

Message.Attachments.Add HyperlinkPart(rs!File_Path, acFullAddress)
rs.MoveNext
Loop

rs.Close

Message.Save

Set App = Nothing
Set Message = Nothing

 

[PHV]

Have you tried rs.MoveFirst before the loop ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886