none
Problem with VBA script in access 2013 to automatically sending emails by using a contact list RRS feed

  • Question

  • Hi All, I am trying to automatically send emails from access 2013 with commands behind a button.  Not sure  what kind of mistake I am making in the script, but for some reason it opening on "1" email instead of "10"(Total number of contacts in email list)? I can't workout the issue as the do until function looks to be right?  Any suggestion as I have not a lot of experience with VBA in Access, so I am also wondering which comman will create the email?

    Below the code

    ' Command27_Click

    '

    '------------------------------------------------------------

    Private Sub Command27_Click()

    Dim day As Integer

    day = Weekday(Date, vbSunday)

    Dim olApp As Outlook.Application

    Dim toMulti As String

    Dim mItem As Outlook.MailItem  ' An Outlook Mail item

    Set olApp = CreateObject("Outlook.Application")

    Set mItem = olApp.CreateItem(olMailItem)

    Dim rs  As Recordset

      With mItem

       Set rs = CurrentDb.OpenRecordset("email_contact_list")

       If rs.RecordCount > 0 Then

       rs.MoveFirst

        Do Until rs.EOF

        Set olApp = CreateObject("Outlook.Application")

        Set mItem = olApp.CreateItem(olMailItem)

            .BodyFormat = olFormatHTML

            toMulti = rs![Contact name]

            .To = toMulti

            .CC = ""

            .Subject = "Product template date - (" & WeekdayName(day) & " - " & Date & ")"

             strbody = "Hi All,<br><br>" & _

                        "<B>Please check out the new simplified template <font face=""Times New Roman"" size=""3"" color=""blue""><I>'Template.xlsx'</I></Font> </B>" & _

                        "<br>" & _

                        "<br>" & _

                        "<B>Explanation file 'Template.xlsx':</B><br>" & _

                        "Regards,<br>" & _

                        "<br>" & _

                        "John"

            .HTMLBody = strbody & "<br>" & .HTMLBody

            .Display

            .Attachments.Add ("C:\Users\Documents\Data-base\Template.xlsx")

        rs.MoveNext

       Loop

        Else

          MsgBox "No email address!"

        End If

       

    End With

        Exit Sub

    End Sub

     

    Anri

    Thursday, April 14, 2016 10:00 AM

Answers

  • Yes, this issue has been solved now let me ask the other question in new section.

    Excellent support

    solved


    Anri

    • Marked as answer by Anri2018 Friday, April 15, 2016 6:18 PM
    Friday, April 15, 2016 6:18 PM

All replies

  • Hi Anti. It might have something to do with the way you're using the same variable for the email. Is the one e-mail displayed always showing the last record's data?
    Thursday, April 14, 2016 12:09 PM
  • Hi,  No it's only creating the first email to first person in the email list. For the other 9 names in the list not even email is created. I think it has to do with the creation of the email oening the form, but identify the issue.

    Anri

    Thursday, April 14, 2016 1:51 PM
  • First of all: create your olApp application object  only once and outside of the Do Until loop. So after after Do Until rs.EOF
    remove line ' Set olApp = CreateObject("Outlook.Application")'

    2nd: before exiting the sub, quit the application and dismiss the object, like this
    olapp.Quit '(check with the windows task manager how many background Outlook instances you have created)
    set olApp = Nothing

    3rd: the email item:
    remove the first instanciation (just before Dim rs as Recordset) 
    Personally I do not use typed mail objects, I declare them as objects: 
        Dim olApp As Object
        Dim mitem As Object
    Your 'with mItem' should start after Do Until and end before rs.MoveNext (it's ugly right now)

    4th:

    Just before end With you should send the meassage, .Send (I've never used .Display)
    and you should add a text body alongside the HTMLbody:
    .Body = "Please check out the new simplified template...."
    .Attachments.Add ("C:\Users\Documents\Data-base\Template.xlsx")
    .Send
    End With
    rs.MoveNext


    Jan D'Hondt - SQL server BI development

    Thursday, April 14, 2016 2:19 PM
  • Hi,  No it's only creating the first email to first person in the email list. For the other 9 names in the list not even email is created. I think it has to do with the creation of the email oening the form, but identify the issue.

    Anri


    Hi Anri. Have you tried stepping through your code? Just curious...
    Thursday, April 14, 2016 7:23 PM
  • Hi Jan,<o:p></o:p>

    Excellent !!!  It's working now.<o:p></o:p>

    I have tried your suggestion to use "Dim olApp As Object" together with "Dim mitem As Object", but ACCESS complains about it when I run the script behind a button?  The first time I had the " If rs.RecordCount > 0 Then" twice in the script, resulting in 105 emails. Lucky I used the command  ".Display" instead of “.SEND”  in the script otherwise other employees would have probably reported me for "SPAM". J<o:p></o:p>

     

    Below the correct and working script for behind a access 2013 button<o:p></o:p>

    Private Sub Command27_Click()

    Dim day As Integer

    day = Weekday(Date, vbSunday)

    Dim olApp As Outlook.Application

    Dim toMulti As String

    Dim mItem As Outlook.MailItem  ' An Outlook Mail item

    Set olApp = CreateObject("Outlook.Application")

    Set mItem = olApp.CreateItem(olMailItem)

    Dim rs  As Recordset

       Set rs = CurrentDb.OpenRecordset("email_contact_")

       If rs.RecordCount > 0 Then

       rs.MoveFirst

    Do Until rs.EOF

    With mItem

           Set mItem = olApp.CreateItem(olMailItem)

              .BodyFormat = olFormatHTML

              toMulti = rs![Contact name]

              .To = toMulti

              .CC = ""

              .Subject = "Product template date - (" & WeekdayName(day) & " - " & Date & ")"

                 strbody = "Hi All,<br><br>" & _

                        "<B>Please check out the new simplified template <font face=""Times New Roman"" size=""3"" color=""blue""><I>'Template.xlsx'</I></Font> for International </B>" & _

                        "<br>" & _

                        "<br>" & _

                        "<B>Explanation file 'Template.xlsx':</B><br>" & _

                        "<br>" & _

                        "Regards,<br>" & _

                        "<br>" & _

                        "John"

              .HTMLBody = strbody & "<br>" & .HTMLBody

              .Display

              .Attachments.Add ("C:\Users\ Documents\Data-base\ \Template.xlsx")

      End With

        rs.MoveNext

    Loop

        Else

              MsgBox "No email address!"

        End If

        olApp.Quit

         Set olApp = Nothing

        Exit Sub

    End Sub


    Anri

    • Marked as answer by Anri2018 Thursday, April 14, 2016 7:29 PM
    • Unmarked as answer by Anri2018 Friday, April 15, 2016 12:50 PM
    Thursday, April 14, 2016 7:29 PM
  • I just wonder what kind of command to use? I want run a query based on the names of the table "email_contact_" and included the customized results in each created email.  The [contact name] exist in a query "products linked", so with want kind of command can I run the query "products linked" for each name in the table "email_contact_"?

     I was thinking of including "Dlookup" in combination with DoCmd.OutputTo acOutputQuery, "", "Excel97-Excel2003Workbook(*.xls)", "Template", False, "template", , acExportQualityPrint  any suggestion here? 


    Anri

    Friday, April 15, 2016 12:55 PM
  • You still set mitem twice.

    Also I would advice to reorder your lines 

    With mItem

           Set mItem = olApp.CreateItem(olMailItem)

    to this sequence

    Set mItem = olApp.CreateItem(olMailItem)

    With mItem

    In your case it worked because you had already instantiated mitem after the olap instantiation (where it is not necessary)

    -- Can you mark my response as answer?

     


    Jan D'Hondt - SQL server BI development

    Friday, April 15, 2016 2:50 PM
  • Yes, this issue has been solved now let me ask the other question in new section.

    Excellent support

    solved


    Anri

    • Marked as answer by Anri2018 Friday, April 15, 2016 6:18 PM
    Friday, April 15, 2016 6:18 PM