Hi, I have this code I use to record and send a notification of incoming consignments, to pre selected employees. With attachments if required. For several companies.
Code:
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, db, rs, 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
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olmailItem)
Set myAttachments = myItem.Attachments
Set lst = Me!filelist
If IsNull(Me.Consignment_Note_Number) Then
t = MsgBox("A Consignment note number is required !", vbOKOnly, "")
Exit Sub
Else
End If
qq = MsgBox(vbCrLf & " Send Automated E-Mails ? " & vbCrLf & vbCrLf, vbYesNo, " Consignment Tracking Advice ")
If Not qq = 6 Then Exit Sub
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, "Attach Image Files to Email")
If q = 6 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
X = Me.filelist.ListCount
For Y = 0 To X - 1
Me.filelist.Selected(Y) = True
Next Y
Else
End If
Set db = CurrentDb
Set rs = db.OpenRecordset("Employees")
rs.MoveFirst
Do While Not rs.EOF
If rs![Auto Receive Tracking Emails] = True Then
ttt = rs![E-Mail Address]
mail_to_list = mail_to_list + ttt & " ; "
End If
rs.MoveNext
Loop
rs.Close
With myItem
For Each vItem In lst.ItemsSelected
If Not IsNull(vItem) Then
ttt = lst.ItemData(vItem)
myItem.Attachments.Add ttt
End If
Next
Set lst = Nothing
email_logo = DLookup("[Email logo location]", "[application data]", " [company title] = forms![consignment note tracking incoming]![to company] ")
myItem.To = mail_to_list
myItem.Subject = "Incoming Logistics Movement C/N # - " & Me.Consignment_Note_Number
myItem.HTMLBody = "<h1>" & "<b>" & "Incoming Consignment Notification C/N # " & Me.Consignment_Note_Number & "</b>" & "</h1>" & "<br>" & "<br>" & _
"Received From - " & "<b>" & Me.From_Company & "</b>" & "." & " Via - " & "<b>" & Me.Courier & "</b>" & ". " & " On - " & "<b>" & Me.Date_Received & "</b>" & "." & "<br>" & "<br>" & _
"Number of items - " & "<b>" & Me.Number_of_Items & "</b>" & "." & " Total weight - " & "<b>" & Me.Weight & "</b>" & " Kg." & "<br>" & "<br>" & _
"Description - " & "<b>" & Me.Description_of_Goods & "</b>" & "<br>" & "<br>" & _
"Attention to - " & "<b>" & Me.addressed_to & "</b>" & "<br>" & "<br>" & _
"P/O or Invoice # Reference - " & "<b>" & Me.po_ref & "</b>" & "<br>" & "<br>" & _
"Notes - " & "<b>" & Me.comments & "</b>" & "." & "<br>" & "<br>" & _
"Thank you." & "<br>" & _
"Logistics department. " & "<br>" & _
"<img src='" & email_logo & "'>" & "<br>" & "<br>" & _
"Any views expressed in this Communication are those of the individual sender and do not necessarily reflect the views of " & _
Me.To_Company & ". This e-mail is confidential and the copyright of " & Me.To_Company & _
". If you are not the intended recipient of this communication please delete and destroy it immediately. " & _
"So far as is permitted by law " & Me.To_Company & " makes no guarantee regarding the integrity of this communication."
myItem.Display
SendKeys "%{s}", True
End With