E-mail Current Record

[ddrinnen]

I need to know how to e-mail current record from a form. Currently I select the record, Copy it, use command button to open new email and past recoed into email. i need to do this with one button.



Thank you.

[June7]

Options:

1. Open report in PrintPreview filtered to single record, right click > Send To (or useVBA code with SendObject method) which will attach the report as a PDF to an email

2. Use VBA code to open an Outlook object and construct an email message by referencing the fields of current record and concatenating with literal text to create email body. https://www.accessforums.net/program...ook-21903.html

[trevor40]

A snipit of code for you, you may be able to use some of this to help you out... Dim sWhere As String ' Where condition
Dim lst As ListBox ' multiselect list box
Dim vItem As Variant ' items in listbox
Dim iLen As Integer ' length of string.
Dim swhare
Dim X As Integer
Dim T, ttt, mail_to_list, q, qq, Response, email_logo
Dim Y As Integer
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olmailItem)
Set myAttachments = myItem.Attachments
Set lst = Me!filelist

' check for empty fields
If Not (IsNull(Me.Consignment_For) And Me.Check22 = True) Then Me.From_Label.ForeColor = 16777215
If Not (IsNull(Me.Delivery_From) And Me.Check23 = True) Then Me.Label47.ForeColor = 16777215
If Not (IsNull(Me.Attention_to) And Me.Check24 = True) Then Me.Label45.ForeColor = 16777215
If Not (IsNull(Me.po_or_invoive_reference) And Me.Check25 = True) Then Me.Label68.ForeColor = 16777215
If Not (IsNull(Me.Notes) And Me.Check26 = True) Then Me.Label14.ForeColor = 16777215
If Not (IsNull(Me.Consignment_Note_Number) And Me.Check21 = True) Then Me.Consignment_Note_Number_Label.ForeColor = 16777215
If Not (IsNull(Me.Courier) And Me.Check27 = True) Then Me.Label22.ForeColor = 16777215
If Not (IsNull(Me.Date_Dispatched) And Me.Check28 = True) Then Me.Date_label.ForeColor = 16777215
If Not (IsNull(Me.Number_of_items_listed) And Me.Check29 = True) Then Me.Label70.ForeColor = 16777215
If Not (IsNull(Me.Weight) And Me.Check30 = True) Then Me.Label24.ForeColor = 16777215
If Not (IsNull(Me.Consignment_Type) And Me.Check31 = True) Then Me.Consignment_Type_Label.ForeColor = 16777215
If Not (IsNull(Me.Description_of_Goods) And Me.Check32 = True) Then Me.Description_of_Goods_Label.ForeColor = 16777215
If (IsNull(Me.Consignment_For) And Me.Check22 = True) Or (IsNull(Me.Delivery_From) And Me.Check23 = True) Or _
(IsNull(Me.Attention_to) And Me.Check24 = True) Or (IsNull(Me.po_or_invoive_reference) And Me.Check25 = True) Or _
(IsNull(Me.Notes) And Me.Check26 = True) Or (IsNull(Me.Consignment_Note_Number) And Me.Check21 = True) Or _
(IsNull(Me.Courier) And Me.Check27 = True) Or (IsNull(Me.Date_Dispatched) And Me.Check28 = True) Or _
(IsNull(Me.Number_of_items_listed) And Me.Check29 = True) Or (IsNull(Me.Weight) And Me.Check30 = True) Or _
(IsNull(Me.Consignment_Type) And Me.Check31 = True) Or (IsNull(Me.Description_of_Goods) And Me.Check32 = True) Then
T = MsgBox("A required field has not been completed !" & vbCrLf & vbCrLf & " Fields shown in red require an entry", vbOKOnly, "Required feilds are empty !")
If (IsNull(Me.Consignment_For) And Me.Check22 = True) Then Me.From_Label.ForeColor = 255
If (IsNull(Me.Delivery_From) And Me.Check23 = True) Then Me.Label47.ForeColor = 255
If (IsNull(Me.Attention_to) And Me.Check24 = True) Then Me.Label45.ForeColor = 255
If (IsNull(Me.po_or_invoive_reference) And Me.Check25 = True) Then Me.Label68.ForeColor = 255
If (IsNull(Me.Notes) And Me.Check26 = True) Then Me.Label14.ForeColor = 255
If (IsNull(Me.Consignment_Note_Number) And Me.Check21 = True) Then Me.Consignment_Note_Number_Label.ForeColor = 255
If (IsNull(Me.Courier) And Me.Check27 = True) Then Me.Label22.ForeColor = 255
If (IsNull(Me.Date_Dispatched) And Me.Check28 = True) Then Me.Date_label.ForeColor = 255
If (IsNull(Me.Number_of_items_listed) And Me.Check29 = True) Then Me.Label70.ForeColor = 255
If (IsNull(Me.Weight) And Me.Check30 = True) Then Me.Label24.ForeColor = 255
If (IsNull(Me.Consignment_Type) And Me.Check31 = True) Then Me.Consignment_Type_Label.ForeColor = 255
If (IsNull(Me.Description_of_Goods) And Me.Check32 = True) Then Me.Description_of_Goods_Label.ForeColor = 255
Exit Sub
Else
End If

Select Case MsgBox("Would you like to print box address labels now ?", vbYesNoCancel, "print box labels")
Case vbYes
DoCmd.OpenForm "print box labels", acNormal, , , , acDialog
Case vbNo
'just continue
Case vbCancel
Exit Sub
End Select

'get attached file list
q = MsgBox("An Email has been generated and will be sent to the selected recipients from the Employee's Menu Tab." & vbCrLf & vbCrLf & " Do you also want to attach a scanned image file to the Email", vbYesNo + vbDefaultButton1, "Attach Image Files to Email")
If q = vbYes Then
Me.filelist.RowSource = ""
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.Title = "Select only the scanned images related to the consignment note."
.Filters.Clear
.AllowMultiSelect = True
.Filters.Add "All Files", "*.*"
If .Show = True Then
For Each varFile In .SelectedItems
Me.filelist.AddItem varFile
Set db = CurrentDb
Set rs = db.OpenRecordset("images", dbOpenDynaset)
rs.AddNew
rs![image location] = varFile
rs![Con Note Number] = Me.Consignment_Note_Number
rs.Update
If Err Then
MsgBox "An error occurred. Please try again."
Response = acDataErrContinue
Else
Response = acDataErrAdded
End If
rs.Close
Set rs = Nothing
Set db = Nothing
Next
Else
End If
End With
For Y = 0 To Me.filelist.ListCount - 1
Me.filelist.Selected(Y) = True
Next Y
Else
End If
Set db = CurrentDb
Set rs = db.OpenRecordset("Consignment Note Tracking - Outgoing", dbOpenDynaset)
rs.AddNew
rs![Consignment Note Number] = Me.Consignment_Note_Number
rs![Date Dispatched] = Me.Date_Dispatched
rs![To Company] = Me.Consignment_For
rs![Description of Goods] = Me.Description_of_Goods
rs![number of items] = Me.Number_of_items_listed
rs![Consignment Type] = Me.Consignment_Type
rs![comments] = Me.Notes
rs![Courier] = Me.Courier
rs![Weight] = Me.Weight
rs![po_ref] = Me.po_or_invoive_reference
rs![Addressed To] = Me.Attention_to
rs![From Company] = Me.Delivery_From
rs.Update
If Err Then
MsgBox "An error occurred. Please try again."
Response = acDataErrContinue
Else
Response = acDataErrAdded
End If
rs.Close
Set rs = Nothing
Set db = Nothing
'get attachments
With myItem
For Each vItem In lst.ItemsSelected
If Not IsNull(vItem) Then
myItem.Attachments.Add lst.ItemData(vItem)
End If
Next
Set lst = Nothing
End With
'get email list
Set db = CurrentDb
Set rs = db.OpenRecordset("Employees")
rs.MoveFirst
Do While Not rs.EOF
If rs![Auto Receive outgoing consignment email] = True Then
mail_to_list = mail_to_list + rs![E-Mail Address] & " ; "
End If
rs.MoveNext
Loop
rs.Close
'add consignee to email in CC
If DLookup("[auto_send_email]", "[customer names]", "[customer name full] = forms![consignment note tracking outgoing].[consignment for]") Then
Select Case MsgBox("Do you also want to add the Consignee to the E-Mail ?", vbYesNo, "")
Case vbYes
T = DLookup("[E-mail Address]", "[customer names]", "[customer name full]= forms![consignment note tracking outgoing].[consignment for]")
myItem.CC = T 'DLookup("[E-mail Address]", "[customer names]", "[customer name]= forms![consignment note tracking outgoing].[consignment for]")
Case vbNo
End Select
End If
'create email
email_logo = DLookup("[Email logo location]", "[application data]", " [company title] = Forms![consignment note tracking Outgoing].Delivery_From ")
logo_color = DLookup("[email custom text color]", "[application data]", " [company title] = Forms![consignment note tracking Outgoing].Delivery_From ")
myItem.To = mail_to_list
myItem.Subject = "Outgoing Consignment Notification for C/N # - " & Me.Consignment_Note_Number
myItem.HTMLBody = "<b>" & "<font size=+2>" & "Outgoing Consignment Notification C/N # " & "</font>" & "<font color= FF0000 >" & "<font size=+3>" & Me.Consignment_Note_Number & "</font>" & "</font>" & "</b>" & "<br>" & "<br>" & _
"Delivery To - " & "<b>" & "<font size=+2>" & Me.Consignment_For & "</font>" & "</b>" & "<br>" & "Via - " & "<b>" & "<font size=+2>" & Me.Courier & "</font>" & "</b>" & _
"&nbsp" & " on " & "&nbsp" & "<b>" & "<font size=+2>" & Format(Me.Date_Dispatched, "dd mmm yyyy") & "</font>" & "</b>" & "<br>" & "<br>" & _
"Consignment Type " & "<b>" & "<font size=+2>" & Forms![consignment note tracking outgoing].Consignment_Type & "</font>" & "</b>" & _
" Description " & "<b>" & "<font size=+2>" & Me.Description_of_Goods & "</font>" & "</b>" & "<br>" & _
"Number of items Dispatched " & "<font size=+2>" & "<b>" & Me.Number_of_items_listed & "</b>" & "</font>" & _
" Total Weight " & "<b>" & "<font size=+2>" & Me.Weight & "</font>" & "</b>" & " Kg." & "<br>" & "<br>" & _
"Attention to - " & "<b>" & "<font size=+2>" & Me.Attention_to & "</font>" & "</b>" & "<br>" & _
"P/O or Invoice # Reference - " & "<b>" & "<font size=+2>" & Me.po_or_invoive_reference & "</font>" & "</b>" & "<br>" & "<br>" & _
"Notes - " & "<b>" & "<font size=+2>" & Me.Notes & "</font>" & "</b>" & "<br>" & "<br>" & _
"Thank you." & "<br>" & "Logistics department. " & "<br>" & _
"<img src='" & email_logo & "'>" & "<br>" & "<br>" & _
"<font color= " & logo_color & ">" & "Any views expressed in this Communication are those of the individual sender and do not necessarily reflect the views of " & _
Me.Delivery_From & ". This e-mail is confidential and the copyright of " & Me.Delivery_From & _
". If you are not the intended recipient of this communication please delete and destroy it immediately. " & _
"So far as is permitted by law " & Me.Delivery_From & " makes no guarantee regarding the integrity of this communication." & "</font>"
em = DLookup("[Auto Send emails on]", "[setup options]", "")
Select Case em
Case Is = 0
myItem.Display ' display only
Case Is = -1
myItem.Display 'send only
SendKeys "%{s}", True
Case Else
End Select
Exit Sub
' ! reset form fields after creating email
Me.Consignment_For = ""
Me.Delivery_From = ""
Me.Attention_to = ""
Me.po_or_invoive_reference = ""
Me.Notes = ""
Me.Consignment_Note_Number = ""
Me.Courier = ""
Me.Date_Dispatched = ""
Me.Number_of_items_listed = ""
Me.Weight = ""
Me.Consignment_Type = ""
Me.Description_of_Goods = ""