Email File as attachment

[hcabs99]

Hi All

I have a database which sends a number of different attachments and different recipients dependant on query results . This all works fine


' SendSites
'
'------------------------------------------------------------
Function SendAutostore()

Set MySet = New ADODB.Recordset
MySet.Open "WMS_EMAILS", CurrentProject.Connection, adOpenStatic

Do Until MySet.EOF
[Forms]![Send].[QSite].Value = MySet![ShippingFrom]
[Forms]![Send].[QEmail].Value = MySet![Addresses (seperate with ]




DoCmd.SendObject acQuery, "Qry_Send_Autostore_File", "Microsoft Excel (*.xls)", [Forms]![Send].[QEmail], "", "", "Email Body", False, ""


MySet.MoveNext
Loop

End Function


I have 1 file which i need to send a .csv file via email. Being as Access doesnt allow me to send .csv files automatically, I've had to go down the route of downloading the correctly formatted file on the c drive of the laptop. Thanks to excellent support from xenou, this is now done.

I now need to add the functionality of sending this file to the correct recipient dependant on the query results using the code above

Can i simply change this bit of the code to send the file from the c drive?

DoCmd.SendObject acQuery, "Qry_Send_Autostore_File", "Microsoft Excel (*.xls)", [Forms]![Send].[QEmail], "", "",

Or is it not as simple as that?

Cheers

 

[xenou]

[COLOR="Red"]CurrentDb.OpenRecordset ("SELECT Addresses FROM WMS_Emails")[/COLOR]
If Not rs.EOF Then
With rs
strTo = rs.Fields("Addresses")
End With
End If
rs.Close

[COLOR="Red"]Set rs = CurrentDb.OpenRecordset("SELECT Addresses FROM WMS_Emails")[/COLOR]

The first line needs to be changed. The second doesn't belong at all. Should be:

Set rs = CurrentDb.OpenRecordset ("SELECT Addresses FROM WMS_Emails")
If Not rs.EOF Then
With rs
strTo = rs.Fields("Addresses")
End With
End If
rs.Close
Set rs = Nothing

complete would be (hopefully):

Private Sub Command21_Click()

'Reference to Microsoft Outlook xx.x object library
Dim OutApp As Object
Dim OutMail As Object
Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset ("SELECT Addresses FROM WMS_Emails")
If Not rs.EOF Then
With rs
strTo = rs.Fields("Addresses")
End With
End If
rs.Close
Set rs = Nothing

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = strTo
.CC = "emialid"
.Subject = "Subject line here"
.Attachments.Add "C:\Documents and Settings\All Users\Documents\LWS_File.txt"
.HTMLBody = "Hi "
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[hcabs99]

[COLOR="Red"]CurrentDb.OpenRecordset ("SELECT Addresses FROM WMS_Emails")[/COLOR]
If Not rs.EOF Then
With rs
strTo = rs.Fields("Addresses")
End With
End If
rs.Close

[COLOR="Red"]Set rs = CurrentDb.OpenRecordset("SELECT Addresses FROM WMS_Emails")[/COLOR]

The first line needs to be changed. The second doesn't belong at all. Should be:

Set rs = CurrentDb.OpenRecordset ("SELECT Addresses FROM WMS_Emails")
If Not rs.EOF Then
With rs
strTo = rs.Fields("Addresses")
End With
End If
rs.Close
Set rs = Nothing

complete would be (hopefully):

Private Sub Command21_Click()

'Reference to Microsoft Outlook xx.x object library
Dim OutApp As Object
Dim OutMail As Object
Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset ("SELECT Addresses FROM WMS_Emails")
If Not rs.EOF Then
With rs
strTo = rs.Fields("Addresses")
End With
End If
rs.Close
Set rs = Nothing

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = strTo
.CC = "emialid"
.Subject = "Subject line here"
.Attachments.Add "C:\Documents and Settings\All Users\Documents\LWS_File.txt"
.HTMLBody = "Hi "
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

You sir are a star, works a treat now, have plugged this code into the 4 different outputs i needed to produce, each of them all download correctly and get emailed using this new code

Many thanks for your help and patience with this!

Cheers

 

[hcabs99]

You sir are a star, works a treat now, have plugged this code into the 4 different outputs i needed to produce, each of them all download correctly and get emailed using this new code

Many thanks for your help and patience with this!

Cheers

Hiya

Another tweak needed!! How would i go about pulling in data from tables into the header or body of the mail. i.e

"Please upload Order XXXXXXX . Any issues with this order failing to upload, please address with customer service team.

XXXXXXX (the order number) would be found on table EDI_Table, Field OrderNumber and should be automatically populated onto the mail.

I would need to do this for various different fields for the email body and header.

Any ideas how i can do this? I've done this in Excel before, but this is not written in the same way

Code reads:

'Reference to Microsoft Outlook xx.x object library
Dim OutApp As Object
Dim OutMail As Object
Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("SELECT Addresses FROM WMS_Emails")
If Not rs.EOF Then
With rs
strTo = rs.Fields("Addresses")
End With
End If
rs.Close
Set rs = Nothing

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = strTo
.CC = ""
.Subject = "Contingency File"
.Attachments.Add "C:\Documents and Settings\All Users\Documents\File.xls"
.HTMLBody = "Please upload order XXXXXX . Any issues with this order failing to upload, please address with customer service team. Delivery details have been uploaded onto the Contingency Sharepoint site "
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub