Results 1 to 3 of 3
  1. #1
    trevor40's Avatar
    trevor40 is offline Advanced db Manager
    Windows XP Access 2003
    Join Date
    Feb 2014
    Location
    Australia
    Posts
    402

    email to many with attachments and data multi company.

    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

    Last edited by June7; 02-15-2014 at 10:46 AM. Reason: add closing code tag

  2. #2
    sdel_nevo is offline Competent Performer
    Windows 7 32bit Access 2010 32bit
    Join Date
    Apr 2013
    Location
    Gloucester, UK
    Posts
    402
    Hi trevor40

    that looks very interesting, thanks for posting

    Steve

  3. #3
    trevor40's Avatar
    trevor40 is offline Advanced db Manager
    Windows XP Access 2003
    Join Date
    Feb 2014
    Location
    Australia
    Posts
    402
    It's 100% complete as yet, there could be problems as I am still putting it together.
    But it does cover getting a file list and saving it and then emailing it to a list, including the file list attachments.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Using query to group attachments for email
    By Monterey_Manzer in forum Access
    Replies: 7
    Last Post: 05-31-2013, 01:37 PM
  2. If and Multiple Email Attachments
    By beckysright in forum Programming
    Replies: 5
    Last Post: 12-13-2012, 03:25 PM
  3. Collecting EMail Attachments using Data Collection Replies
    By Blindswerve in forum Database Design
    Replies: 1
    Last Post: 05-16-2012, 04:56 PM
  4. Send email with attachments
    By rbiggs in forum Programming
    Replies: 12
    Last Post: 07-23-2011, 12:50 PM
  5. Send Report and Attachments in Email
    By Pimped in forum Programming
    Replies: 1
    Last Post: 06-21-2011, 02:51 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums