Results 1 to 4 of 4
  1. #1
    Join Date
    Nov 2008
    Posts
    59

    Unanswered: Changing the way my Sendmail function sends e-mails

    Sorry, I posted the code over the rest of my message. Sorry. Here is what I meant to say:

    Hi,
    I have created a Sendmail function on one of my pages but am having some problems getting it to work the way I want. At the moment it opens a seperate e-mail for every e-mail address in my query. How can I change the script below so that it opens just one e-mail with all the e-mail addresses listed under BCC rather than several e-mails, each with just one recipient?

    Code:
    Public Sub SendMail()
    'Provides the Send Mail automation
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim strSubject As String
    Dim strEmailAddress As String
    Dim strEmailAddress2 As String
    Dim strEMailMsg As String
    Dim ingCounter As Integer
    Dim intCount As Integer
    
    ' Write messagebox content to a file
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set theFile = fso.CreateTextFile("C:\Email.htm", vbTrue)
    
    
            theFile.WriteLine "<HTML>"
            theFile.WriteLine "<BODY style='font-family:Century Gothic;'>"
            theFile.WriteLine "<p></p>"
            theFile.WriteLine [Message]
            theFile.WriteLine "<br />"
    
    ' Append the user's signature file
    
          ' theFile.WriteLine fso.OpenTextFile("K:\Admin & office\logo & letterhead\email-signature.html").ReadAll
            theFile.WriteLine "</BODY>"
            theFile.WriteLine "</HTML>"
            theFile.Close
            
          
    ' Close the file which now contains the email body and signature and read the content into myHTML
            
            Set f = fso.OpenTextFile("C:\Email.htm", 1)
            MyHTML = f.ReadAll
            f.Close
    
    strSubject = [Subject]
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("qryEmailOut")
    Set rst2 = dbs.OpenRecordset("qryEmailOut2")
    
    rst.MoveFirst
    Do Until rst.EOF
        
        strEmailAddress = rst![email address]
        strEMailMsg = MyHTML
    
        'EMAIL USER DETAILS & ATT REPORT
        DoCmd.SendObject acSendNoObject, stDocName, acFormatRTF, , _
        , strEmailAddress, strSubject, strEMailMsg, , True
        
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
    
    rst2.MoveFirst
    Do Until rst2.EOF
        
        strEmailAddress2 = rst2![email address]
        strEMailMsg = MyHTML
    
        'EMAIL USER DETAILS & ATT REPORT
        DoCmd.SendObject acSendNoObject, stDocName, acFormatRTF, , _
        , strEmailAddress2, strSubject, strEMailMsg, , True
        
        rst2.MoveNext
    Loop
    rst2.Close
    Set rst2 = Nothing
    
    dbs.Close
    Set dbs = Nothing
        
    'Run update to update the sent mail check box
        DoCmd.SetWarnings False
        
        DoCmd.SetWarnings True
        
    End Sub
    Last edited by slaterino; 04-28-09 at 21:27.

  2. #2
    Join Date
    Nov 2007
    Location
    Adelaide, South Australia
    Posts
    4,049
    ....and....
    Owner and Manager of
    CypherBYTE, Microsoft Access Development Specialists.
    Microsoft Access MCP.
    And all around nice guy!


    "Heck it's something understood by accountants ... so it can't be 'that' difficult..." -- Healdem
    "...teach a man to code and he'll be frustrated for life! " -- georgev

  3. #3
    Join Date
    May 2005
    Location
    Nevada, USA
    Posts
    2,888
    Provided Answers: 6
    Paul

  4. #4
    Join Date
    Jul 2004
    Location
    South Dakota
    Posts
    267
    All you need to do is create a string that contains the email addresses separated with a semi-colon. You just need to loop through all the records in rst and then send the email from outside the loop.

    Change this...

    Code:
    Do Until rst.EOF
        
        strEmailAddress = rst![email address]
        strEMailMsg = MyHTML
    
        'EMAIL USER DETAILS & ATT REPORT
        DoCmd.SendObject acSendNoObject, stDocName, acFormatRTF, , _
        , strEmailAddress, strSubject, strEMailMsg, , True
        
        rst.MoveNext
    Loop
    to something like this...

    Code:
    Do Until rst.EOF
        strEmailAddress = strEmailAddress & "; " & rst![email address]
        rst.MoveNext
    Loop
    
        strEMailMsg = MyHTML
    
        'EMAIL USER DETAILS & ATT REPORT
        DoCmd.SendObject acSendNoObject, stDocName, acFormatRTF, , _
        , strEmailAddress, strSubject, strEMailMsg, , True
    You will need to do this for rst2 as well.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •