Page 2 of 2 FirstFirst 12
Results 16 to 29 of 29
  1. #16
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    RTFBodyX is the name of your Sub?
    Upload a sample DB with enough to see the problem. We will be here for ever otherwise.
    I will not amend the code but try and find out what you have done and advise you what to amend.

    You call RTFBodyX from whatever you are using to create the email, button click even perhaps.

    Walk through your code with F8.


    See the link about debugging in my signature and follow that.
    Last edited by Welshgasman; 08-23-2022 at 01:46 PM.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  2. #17
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    Remove the ADO function, you only need the DAO version, else you will need to set a reference to ADO in the VB window.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  3. #18
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    Remove the ADO function, you only need the DAO version, else you will need to set a reference to ADO in the VB window.
    https://docs.microsoft.com/en-us/sql...l-server-ver16
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  4. #19
    atuljadhav is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2022
    Posts
    15
    Finally it's work half, now the issue is different

    When i run this macro it ask me to enter customer code, after enter customer code, email open without query (GetData2) data in body, also in "To" it is taking multiple number of email address, e.g, if for one customer 10 line item is there then in "To" address it take same email address 10 times, it should be onlyone email, also in body there is no data coming.

    i need to paste query data in body as table format.

    after this my requrement will be done, please help

    i have modify codes, so please refer belwo codes only.





    Code:
    Function fDAOGenericRst(strSQL As String, _
                        Optional intType As DAO.RecordsetTypeEnum = dbOpenDynaset, _
                        Optional intOptions As DAO.RecordsetOptionEnum, _
                        Optional intLock As DAO.LockTypeEnum, _
                        Optional pdb As DAO.Database) As DAO.Recordset
                                              
        Dim db As Database
        Dim qdf As QueryDef
        Dim rst As DAO.Recordset
        Dim prm As DAO.Parameter
        
        If Not pdb Is Nothing Then
            Set db = pdb
        Else
            Set db = CurrentDb
        End If
        
        On Error Resume Next
        Set qdf = db.QueryDefs(strSQL)
        If Err = 3265 Then
            Set qdf = db.CreateQueryDef("", strSQL)
        End If
        On Error GoTo 0
        
        For Each prm In qdf.Parameters
            prm.Value = Eval(prm.Name)
        Next
        
        If intOptions = 0 And intLock = 0 Then
            Set rst = qdf.OpenRecordset(intType)
        ElseIf intOptions > 0 And intLock = 0 Then
            Set rst = qdf.OpenRecordset(intType, intOptions)
        ElseIf intOptions = 0 And intLock > 0 Then
            Set rst = qdf.OpenRecordset(intType, intLock)
        ElseIf intOptions > 0 And intLock > 0 Then
            Set rst = qdf.OpenRecordset(intType, intOptions, intLock)
        End If
        Set fDAOGenericRst = rst
        
        Set prm = Nothing
        Set rst = Nothing
        Set qdf = Nothing
        Set db = Nothing
        
    End Function
    
    
     Sub RTFBodyX()
        'Opens the current access database
         Dim db As DAO.Database
         Set db = CurrentDb
         Dim RS As DAO.Recordset
         Dim EmailAdd As String
         'Mail Message MM
         Dim MM As String
         Dim qrySQL As String
    
         Set db = CurrentDb
    
        ' Set parameter values.
            
         DoCmd.SetParameter "[Acct_No]", "" & InputBox("Enter Account No:") & ""
            
         'Creates the SQL string - query contains just email addresses
          qrySQL = "SELECT * FROM GetData2;"
          
         
         'creates a recordset (table) based on the sql Statement above
          Set RS = fDAOGenericRst(qrySQL, dbOpenDynaset)
    
    
          Do Until RS.EOF
              'creates the email string by reading the email from each record
              EmailAdd = EmailAdd & " ; " & RS!Email_Address
              'move next record RS!EMAIL
              RS.MoveNext
          Loop
    
        'creates Email body in HTML Format
    
         MM = "Dear Delegates,"
         MM = MM & "Blah blah blah"
    
         'create new email
         Set olook = CreateObject("outlook.application")
    
         Set oMail = olook.CreateItem(0)
         'Set parameters
         With oMail
             .To = EmailAdd
             .HTMLBody = MM
             .Subject = "Our title here"
             .CC = "address@address.com"
             .Display
         End With
     End Sub

  5. #20
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    Well Access is only doing what you are telling it to?

    You concanenate all the emails addresses within the recordset loop, you have NO criteria for the query and you are not putting anything into the email body apart from MM ?
    I cannot even see where Acc_No is being used.

    So just guessing here,
    You would need to supply criteria to get just the records for a particular account.
    Set the email address once, then within the recordset loop, add the required data to a string variable with whatever html tags you require
    When recordset loop is finished then set the email html body to your html string.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  6. #21
    atuljadhav is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2022
    Posts
    15
    Yes, i agree, Access will do whatever i say
    now i have change codes now the query result getting paste on body as per my requirement but still emails get multiple.
    how i will get single email address, irrespective multiple line item.






    Code:
    Function fDAOGenericRst(strSQL As String, _
                        Optional intType As DAO.RecordsetTypeEnum = dbOpenDynaset, _
                        Optional intOptions As DAO.RecordsetOptionEnum, _
                        Optional intLock As DAO.LockTypeEnum, _
                        Optional pdb As DAO.Database) As DAO.Recordset
                                              
        Dim db As Database
        Dim qdf As QueryDef
        Dim rst As DAO.Recordset
        Dim prm As DAO.Parameter
        
        If Not pdb Is Nothing Then
            Set db = pdb
        Else
            Set db = CurrentDb
        End If
        
        On Error Resume Next
        Set qdf = db.QueryDefs(strSQL)
        If Err = 3265 Then
            Set qdf = db.CreateQueryDef("", strSQL)
        End If
        On Error GoTo 0
        
        For Each prm In qdf.Parameters
            prm.Value = Eval(prm.Name)
        Next
        
        If intOptions = 0 And intLock = 0 Then
            Set rst = qdf.OpenRecordset(intType)
        ElseIf intOptions > 0 And intLock = 0 Then
            Set rst = qdf.OpenRecordset(intType, intOptions)
        ElseIf intOptions = 0 And intLock > 0 Then
            Set rst = qdf.OpenRecordset(intType, intLock)
        ElseIf intOptions > 0 And intLock > 0 Then
            Set rst = qdf.OpenRecordset(intType, intOptions, intLock)
        End If
        Set fDAOGenericRst = rst
        
        Set prm = Nothing
        Set rst = Nothing
        Set qdf = Nothing
        Set db = Nothing
        
    End Function
    
    
     Sub RTFBodyX()
        'Opens the current access database
         Dim db As DAO.Database
         Set db = CurrentDb
         Dim RS As DAO.Recordset
        
        Const ForReading = 1, ForWriting = 2, ForAppending = 3
        Dim fs, f
        Dim RTFBody, strTo
    
    
    
         Dim EmailAdd As String
         'Mail Message MM
         Dim MM As String
         
         Dim qrySQL As String
    
         Set db = CurrentDb
    
        ' Set parameter values.
            
         DoCmd.SetParameter "[Acct_No]", "" & InputBox("Enter Account No:") & ""
            
        DoCmd.OutputTo acOutputQuery, "GetData2", acFormatHTML, "GetData2.htm"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("GetData2.htm", ForReading)
    RTFBody = f.ReadAll
    'Debug.Print RTFBody
    f.Close
    
         
         'Creates the SQL string - query contains just email addresses
          qrySQL = "SELECT * FROM GetData2;"
          
         
         'creates a recordset (table) based on the sql Statement above
          Set RS = fDAOGenericRst(qrySQL, dbOpenDynaset)
    
    
          Do Until RS.EOF
              'creates the email string by reading the email from each record
              EmailAdd = EmailAdd & " ; " & RS!Email_Address
              'move next record RS!EMAIL
              RS.MoveNext
          Loop
    
        'creates Email body in HTML Format
    
         MM = "Dear Delegates,"
         MM = MM & "Blah blah blah"
    
         'create new email
         Set olook = CreateObject("outlook.application")
    
         Set oMail = olook.CreateItem(0)
         'Set parameters
         With oMail
             .To = EmailAdd
             .HTMLBody = RTFBody
             .Subject = "Our title here"
             .CC = "address@address.com"
             .Display
         End With
     End Sub

  7. #22
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    Well I can see you are trying

    First get used to DIMming your variables correctly, AS String, As Long, whatever they need to be.
    Why are you using a loop still for the email address? You need to understand what the code does, it is called a language for a reason.

    I would either use a DlookUp() to the email address, using the Account_ID (I am assuming is the criteria) or in your SQL string, Also use DISTINCT and only retrieve the email address, if that is all you are going to use.

    I have to go out now, so no further replies for the rest of the day.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  8. #23
    atuljadhav is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2022
    Posts
    15
    Ok, Thanks

    i have remove loop and add below code instead

    Code:
    EmailAdd = DLookup("[Email_Address]", "GetData2")
    now it's working fine, still have to work more, i have to add

    BCC
    Subject
    Body

    i will try and if i get any issue will revert on this,

    But that you very much, I learn a lot from this thread, i know you can modify the codes but if you did then i will not learn.
    i like the way you solve my problelm

    thanks once again.

  9. #24
    atuljadhav is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2022
    Posts
    15
    No, it's not working, even i change customer code it take only for one customer which was hard coded for testing purpose

    the moment i change it to dynamical and assign Parameter (Acct_No) and getting error on "prm.Value = Eval(prm.Name)" this line

    run time error show 2482, cannot find "prm" you enter in the expression.

    i will update after my review

  10. #25
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    Quote Originally Posted by atuljadhav View Post
    Ok, Thanks

    i have remove loop and add below code instead

    Code:
    EmailAdd = DLookup("[Email_Address]", "GetData2")
    now it's working fine, still have to work more, i have to add

    BCC
    Subject
    Body

    i will try and if i get any issue will revert on this,

    But that you very much, I learn a lot from this thread, i know you can modify the codes but if you did then i will not learn.
    i like the way you solve my problelm

    thanks once again.
    Think about this logically.
    If you are asking for accountID for the query, then I would assume multiple accounts are in GetData?, so you need to retrieve only those that match AccountID. To use a Dlookup() you would need the same as criteria, else you will pick up the first one found.

    I have never used SetParameter, so not sure it would work for the way you are trying? https://docs.microsoft.com/en-us/off...d.setparameter

    I would set either a global or tempvar to the account ID, and use that in the query, or even better in the sql string of the SELECT
    So
    Code:
         Dim strAcctNo AS String  
         DoCmd.SetParameter "[Acct_No]", "" & InputBox("Enter Account No:") & ""
            
         'Creates the SQL string - query contains just email addresses
          qrySQL = "SELECT * FROM GetData2 WHERE [Acct_No] ='" & strAcctNo & "';"
    Then from the very first record retrieve the email address, once only.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  11. #26
    atuljadhav is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2022
    Posts
    15
    below is the "AR" Table, you can see each customer has multiple line item.

    Click image for larger version. 

Name:	AR Table.JPG 
Views:	10 
Size:	97.4 KB 
ID:	48566

    Table "Customer_Master" has customer email address.

    Click image for larger version. 

Name:	Customer Master Table.JPG 
Views:	10 
Size:	33.2 KB 
ID:	48567

    have created query to get the data only for one customer which can be enter parameter [Acct_No].


    Click image for larger version. 

Name:	GetData2 Query.JPG 
Views:	10 
Size:	43.8 KB 
ID:	48568


    when i open query, it ask me to enter customer code and it give me below data,

    Click image for larger version. 

Name:	Query Result.JPG 
Views:	10 
Size:	67.9 KB 
ID:	48569
    this data i want to send thru email and .To = Email_Address
    in body paste this table in HTML format and send



    Thanks in advance

  12. #27
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    I would just use a DlookUp() to get the email address one time.
    Then TBH I would attach that data as a PDF from a report. Much better format and output.

    Otherwise you are going to need that recordset as you have now and build the html dynamically. Not ideal for people with little or no experience of Access.

    Here is how I did something similar. You are getting the whole function with code you would not use, but I am not going to strip out any code. See if you can understand the logic flow.


    Code:
    Private Sub cmdEmail_Click()
        On Error GoTo Err_Handler
        ' Automate the routine to send notifications of Payments and deposits for clients
        Dim strFilter As String, strClientType As String
        Dim strDate As String, strSQLEmail As String
        Dim strType As String, strClient As String, str3rdID As String, str3rdParty As String, str3rdPartyType As String, strAmount As String, strRef As String, strMethod As String
        Dim strCaseWorker As String, strDatetype As String, strPad As String, strEndPad As String, strPadCol As String, strBlankLine As String, strNotes As String
        Dim strBalance As String, dblBalance As Double
        Dim iColon As Integer, intTransactions As Integer
        Dim lngCurrentRec As Long
        Dim blnDisplayMsg As Boolean, blnSameEmail As Boolean
        Dim db As Database
        Dim rs As DAO.Recordset, rsCW As DAO.Recordset
        Dim blnSameClientType As Boolean
    
    
        ' Now the Outlook variables
        Dim objOutlook As Outlook.Application
        Dim objOutlookMsg As Outlook.MailItem
        Dim objOutlookRecip As Outlook.Recipient
        Dim objOutlookAttach As Outlook.Attachment
        Dim strSigPath As String, strSignature As String, strAttachFile As String
        Dim strHeader As String, strFooter As String, strBody As String, strTemplatePath As String, strAppdata As String
        Dim intBody As Integer, intAccount As Integer
    
    
        ' Set up HTML tags
        strPad = "<tr><td>"
        strEndPad = "</td></tr>"
        strPadCol = "</td><td>"
        strBlankLine = "<tr></tr>"
    
    
    
    
        On Error GoTo Err_Handler
    
    
        'Establish all the static Outlook Data
    
    
        ' Get appdata path
        strAppdata = Environ("Appdata")
        
        ' Set paths
        strTemplatePath = strAppdata & "\Microsoft\Templates"
        strSigPath = strAppdata & "\Microsoft\Signatures\Ssafa.htm"
        
        
        'Get the signature if it exists
        If Dir(strSigPath) <> "" Then
            strSignature = GetBoiler(strSigPath)
            intBody = InStr(strSignature, "<div class=WordSection1>")
            'intBody = InStr(strSignature, "<BODY>")
            strHeader = Left(strSignature, intBody + 24) ' 5
            strFooter = Mid(strSignature, intBody + 24) ' 6
        End If
    
    
        ' See if Outlook is open, otherwise open it
        'If fIsOutlookRunning = False Then
        Set objOutlook = CreateObject("Outlook.Application")
        'Call OpenOutlook
        'Pause (5)
        ' Else
        'Set objOutlook = GetObject(, "Outlook.Application")
        'End If
        
        ' Make sure we save any changed data and then get recordset
        If Me.Dirty Then Me.Dirty = False
        ' Update the status bar
        SetStatusBar ("Collecting records.....")
    
    
        strSQLEmail = "SELECT  Format([TransactionDate],""yyyymmdd"") & Format([ID],""000000"") AS UKey, Emails.*, tblClient.ClientDivision From Emails "
        strSQLEmail = strSQLEmail & "LEFT JOIN tblClient ON Emails.CMS = tblClient.ClientCMS "
        strSQLEmail = strSQLEmail & "WHERE (((Emails.EmailStatus) = 'Yes')) " ' AND (Emails.DelayEmail = False)) "
        'strSQLEmail = strSQLEmail & "ORDER BY Emails.Client, Emails.TranType, Emails.ID, Emails.TransactionDate;"
        strSQLEmail = strSQLEmail & "ORDER BY Emails.Client, Emails.TranType, Format([TransactionDate],""yyyymmdd"") & Format([ID],""000000"") ;"
    
    
        ' Create the Outlook session.
        'Set objOutlook = GetObject(, "Outlook.Application")
        'Set objOutlook = New Outlook.Application
        
        ' Open lookup table for Email CC Name (normally a Case Worker)
        Set db = CurrentDb
        Set rsCW = db.OpenRecordset("SELECT * from Lookups WHERE DataType = 'Email' AND DeActiveDate IS NULL")
        ' Save the current record position
        lngCurrentRec = Me.CurrentRecord
        ' Now get the data for the emails
        Set rs = db.OpenRecordset(strSQLEmail)
        
        ' Check we have some records to process
        If rs.RecordCount = 0 Then
            MsgBox "No records to process?", vbOKOnly, "Send Emails"
            Exit Sub
        End If
        ' OK, we are good so send the emails.
    
    
        ' Decide whether to display or just send emails
        blnDisplayMsg = Me.chkDisplay
    
    
        rs.MoveFirst
    
    
        SetStatusBar ("Creating Emails.....")
        ' Now walk through each record
        Do While Not rs.EOF
            ' Set flag and field to check
            blnSameClientType = True
            strClientType = rs!Client & rs!TranType
            strType = rs!TranType
            
            ' Create the message if first time we are in a different client or tran type.
             Set objOutlookMsg = objOutlook.CreateItemFromTemplate(strTemplatePath & "\SSAFA Email.oft")
            With objOutlookMsg
                ' Set the category
                .Categories = "SSAFA"
                .Importance = olImportanceHigh
                ' Add the To recipient(s) to the message. (Also work out which account to send on 12/07/19)
                If rs!ClientDivision = "SSW" Then
                    Set objOutlookRecip = .Recipients.Add("Jim Needs - Personal")
                    objOutlookRecip.Type = olTo
                    intAccount = 2
                Else
                    Set objOutlookRecip = .Recipients.Add("South West Wales SSAFA")
                    objOutlookRecip.Type = olTo
                    intAccount = 3
                End If
                ' Add the CC recipient(s) to the message.
                If rs!CCOffice And rs!ClientDivision = "SSW" Then
                    Set objOutlookRecip = .Recipients.Add("South West Wales SSAFA")
                    objOutlookRecip.Type = olCC
                End If
                
                ' Need to get the Case Worker name from table, might be deactivated, so not in recordset
                If rs!CaseWorker > 0 Then
                    rsCW.FindFirst "[ID] = " & rs!CaseWorker
                    If rsCW.NoMatch Then
                        strCaseWorker = ""
                    Else
                        strCaseWorker = rsCW!Data
                    End If
                Else
                    strCaseWorker = ""
                End If
    
    
                If strCaseWorker <> "" Then
                    Set objOutlookRecip = .Recipients.Add(strCaseWorker)
                    objOutlookRecip.Type = olCC
                End If
                
                ' Add Glyn in as BCC for CMS update - 12/02/19
                ' Only if SSW and he is not the caseworker
                If rs!ClientDivision = "SSW" And strCaseWorker <> "Glyn Davies" Then
                    Set objOutlookRecip = .Recipients.Add("Glyn Davies")
                    objOutlookRecip.Type = olBCC
                End If
    
    
                
                ' Set the Format, Subject, Body, and Importance of the message.
                '.BodyFormat = olFormatHTML
                strClient = rs!Client
    
    
    
    
                If strType = "Payment" Then
                    .Subject = " Payment Made - " & strClient
                Else
                    .Subject = "Deposit Received - " & strClient
                End If
                ' Now start the email with header
                'iColon = InStr(strClient, ":")
                ' If iColon = 0 Then iColon = Len(strClient) + 1
                .HTMLBody = strHeader & "<table border = '0' cellpadding = '5' cellspacing = '5'>"
                '    .HTMLBody = .HTMLBody & "<td>" & "Client: " & strPadCol & Left(strClient, iColon - 1) & strEndPad
                'End If
                ' Set counter to zero for count of transactions
                intTransactions = 0
            End With
    
    
            Do While blnSameClientType
                strDate = rs!TransactionDate
                strType = rs!TranType
                str3rdParty = rs!ThirdParty
                strAmount = Format(rs!Amount, "Currency")
                'strBalance = Format(rs!Balance, "Currency")
                'strBalance = Format(DSum("Amount", "Emails", "CMS = " & rs!CMS & " AND ID <= " & rs!ID), "Currency")
                ' Now using unique key Ukey to get correct running balance for entries out of sequence
                dblBalance = DSum("Amount", "Emails", "CMS = " & rs!CMS & " AND format(TransactionDate,'yyyymmdd')& format(ID,'000000') <= '" & rs!Ukey & "'")
                strBalance = Format(dblBalance, "Currency")
                ' Missed in sequence dates was producing erroneous balances 240620
                'strBalance = Format(Nz(DSum("Amount", "Emails", "CMS = " & [CMS] & " AND ID <=" & [ID]), 0), "Currency")
                'Now Calculated on the fly
                'strBalance = Format(rs!Balance, "Currency") ' was Format(DSum("[Amount]", "Emails", "[CMS]=" & rs!CMS & " AND ID <= " & rs!ID), "Currency")
                
                ' Make strBalance Red if negative
                If dblBalance < 0 Then
                    strBalance = "<font color=""Red"">" & strBalance & "</font>"
                End If
                
                strRef = rs!Reference
                strMethod = rs!Method
                
                'strDatetype = "Date "
                If strType = "Payment" Then
                    str3rdPartyType = "Recipient:"
                    strDatetype = "Date Paid:"
                Else
                    str3rdPartyType = "From Donor:"
                    strDatetype = "Received:"
                End If
    
    
                strNotes = Nz(rs!Notes, "")
            
            
                ' Now build the body of the message
                
                ' Make sure we have a colon in client, else use whole field
                
                ' Now add the variable data
                With objOutlookMsg
                    .HTMLBody = .HTMLBody & strPad & str3rdPartyType & strPadCol & str3rdParty & strEndPad
                    .HTMLBody = .HTMLBody & strPad & strDatetype & strPadCol & strDate & strEndPad
                    .HTMLBody = .HTMLBody & strPad & "Method:" & strPadCol & strMethod & strEndPad
                    .HTMLBody = .HTMLBody & strPad & "Reference:" & strPadCol & strRef & strEndPad
                    .HTMLBody = .HTMLBody & strPad & "Amount:" & strPadCol & strAmount & strEndPad
                    .HTMLBody = .HTMLBody & strPad & "Balance:" & strPadCol & strBalance & strEndPad
                    ' Add any notes if they exist
                    If Len(strNotes) > 0 Then
                        .HTMLBody = .HTMLBody & strPad & "Notes:" & strPadCol & strNotes & strEndPad
    
    
                    End If
    '                ' Add blank line for next set
                    .HTMLBody = .HTMLBody & strBlankLine & strBlankLine
                End With
                
                'Now update the record
                rs.Edit
                rs!EmailStatus = "Sent"
                rs!EmailDate = Date
                rs.Update
    
    
                ' Now get next record
                rs.MoveNext
                ' Has client or tran type changed?
                If Not rs.EOF Then
                    If strClientType = rs!Client & rs!TranType Then
                        blnSameClientType = True
                    Else
                        blnSameClientType = False
                    End If
                Else
                    blnSameClientType = False
                End If
                ' Increment the counter
                intTransactions = intTransactions + 1
            Loop                                     ' End blnClientType loop
            
            ' Now add the footer and amend subject to indicate how many transactions in email
            With objOutlookMsg
                .Subject = .Subject & " - " & intTransactions & " " & strType
                If intTransactions > 1 Then
                    .Subject = .Subject & "s"
                End If
                
                ' Need to amend the footer depending on account being used intAccount = 2 = SSW, 3 is NPT
                If intAccount = 3 Then
                    strFooter = Replace(strFooter, "Divisional Treasurer, Swansea South &amp; West", "Temporary Divisional Treasurer, Neath &amp; Port Talbot")
                End If
                
                ' Now add the footer
                .HTMLBody = .HTMLBody & "</table>" & strFooter
                '.Importance = olImportanceHigh  'High importance
                'Debug.Print strHeader
                'Debug.Print .htmlbody
                'Debug.Print strFooter
                ' Resolve each Recipient's name.
                For Each objOutlookRecip In .Recipients
                    'Debug.Print objOutlookRecip.Name
                    objOutlookRecip.Resolve
                Next
        
                ' Should we display the message before sending?
                .SendUsingAccount = objOutlook.Session.Accounts.Item(intAccount)
                If blnDisplayMsg Then
                    .Display
                Else
                    .Save
                    .Send
                End If
            End With
        
                
        Loop
        SetStatusBar ("Emails created.....")
        DoCmd.GoToRecord , , acGoTo, lngCurrentRec
        cmdRequery_Click
    Proc_Exit:
        Set objOutlook = Nothing
        Set objOutlookMsg = Nothing
        Set objOutlookRecip = Nothing
        Set objOutlookAttach = Nothing
        Set rs = Nothing
        Set rsCW = Nothing
        Set db = Nothing
        SetStatusBar (" ")
        Exit Sub
        
    Err_Handler:
        MsgBox Err.Number & " " & Err.Description
        Resume Proc_Exit
    
    
    
    
    
    
    End Sub
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  13. #28
    atuljadhav is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2022
    Posts
    15
    Ok, let me try my issue in another forum.

    Thanks for your help.

  14. #29
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

Page 2 of 2 FirstFirst 12
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 2
    Last Post: 05-04-2017, 08:06 AM
  2. Replies: 1
    Last Post: 11-07-2016, 11:18 AM
  3. Email report to value (email address) in a field
    By JackieEVSC in forum Programming
    Replies: 7
    Last Post: 08-28-2015, 11:18 AM
  4. Automatically enter email address from customer table
    By Pure Salt in forum Import/Export Data
    Replies: 3
    Last Post: 07-09-2014, 08:03 AM
  5. Replies: 1
    Last Post: 05-01-2014, 11:37 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