Best way to achieve this?

Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 19:13
Joined
Sep 21, 2011
Messages
16,760
Hi all,

I have a table that I use for recording payments and deposits for a charity I volunteer for. I am a divisional treasurer. I also use it to generate emails to the relevant interested parties.

As you will see from the code below I set a filter on a field and update this and another field after I have sent the email.

Now I would like to enhance this and put all the the data for a client into one email.

I know that I will need to sort the relevant data into client order and have just found DoCmd.SetOrderBy on a google search, but I only have Access 2007 and that is for Access 2013 and later :(

So what would be the best way to go about this please. Would it be a query to retrieve the all the input data and another query to update on each record as processed, or is there a better way?

TIA

My current code is below.
and the email body tends to look like this, albeit correctly aligned.
Code: 
Client: 	  	Mr A.H.Corbin
		
Recipient: 	  	R.A.C.F
		
Date Paid: 	  	16/03/2016
		
Payment Method: 	  	BACS
		
Reference: 	  	Corbin 9099
		
Payment Amount: 	  	£520.00
		
Notes: 	  	Refund of annuity deposit.
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
Dim strDate 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, strNotes As String
Dim iColon As Integer
Dim lngCurrentRec As Long
Dim blnDisplayMsg As Boolean
Dim db As Database
Dim rs As DAO.Recordset, rsCW As DAO.Recordset

' 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

' Set up HTML tags
strPad = "<tr><td>"
strEndPad = "</td></tr><tr></tr>"
strPadCol = "</td><td>  </td><td>"

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, "<BODY>")
        strHeader = Left(strSignature, intBody + 5)
        strFooter = Mid(strSignature, intBody + 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
    
    
    ' 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'")
' Save the current record position
    lngCurrentRec = Me.CurrentRecord
    
' Now set the filter to get just the rows we want
    strFilter = "Yes"
    
    Me.Filter = "EmailStatus = """ & strFilter & """"
    Me.FilterOn = True

' Make sure we save any changed data and then get recordset
If Me.Dirty Then Me.Dirty = False

' Decide whether to display or just send emails
blnDisplayMsg = Me.chkDisplay

Set rs = Me.RecordsetClone
    rs.MoveFirst
    
' Now walk through each record
Do While Not rs.EOF
        ' MsgBox rs!ID

        strDate = rs!TransactionDate
        strType = rs!TranType
        strClient = rs!Client
        str3rdParty = rs!ThirdParty
        strAmount = Format(rs!Amount, "Currency")
        strRef = rs!Reference
        strMethod = rs!Method
        ' Need to get the Case Worker name from table'
        If rs!CaseWorker > 0 Then
            rsCW.FindFirst "[ID] = " & rs!CaseWorker
            strCaseWorker = rsCW!Data
        Else
            strCaseWorker = ""
        End If
        strNotes = Nz(rs!Notes, "")
        
        
        ' Now populate the outlook fields
        ' Create the message.
        'Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
        
        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.
            Set objOutlookRecip = .Recipients.Add("Jim Needs - SSAFA Swansea")
            objOutlookRecip.Type = olTo
    
            ' Add the CC recipient(s) to the message.
            If rs!CCOffice Then
                Set objOutlookRecip = .Recipients.Add("** SSAFA West Glamorgan Branch")
                objOutlookRecip.Type = olCC
            End If
            
            If strCaseWorker <> "" Then
                Set objOutlookRecip = .Recipients.Add(strCaseWorker)
                objOutlookRecip.Type = olCC
            End If
    
            ' Set the Format, Subject, Body, and Importance of the message.
            .BodyFormat = olFormatHTML
            strDatetype = "Date "
            If strType = "Payment" Then
                .Subject = " Payment Made - " & strClient
                str3rdPartyType = "Recipient: "
                strDatetype = strDatetype & "Paid: "
            Else
                .Subject = "Deposit Received - " & strClient
                str3rdPartyType = "Received From: "
                strDatetype = strDatetype & "Received: "
    
            End If
            
            ' Now build the body of the message
            
            ' Make sure we have a colon in client, else use whole field
            iColon = InStr(strClient, ":")
            If iColon = 0 Then iColon = Len(strClient) + 1
            
            .HTMLBody = strHeader & "<table><tr>"
            .HTMLBody = .HTMLBody & "<td>" & "Client: " & strPadCol & Left(strClient, iColon - 1) & strEndPad
            .HTMLBody = .HTMLBody & strPad & str3rdPartyType & strPadCol & str3rdParty & strEndPad
            .HTMLBody = .HTMLBody & strPad & strDatetype & strPadCol & strDate & strEndPad
            .HTMLBody = .HTMLBody & strPad & "Payment Method: " & strPadCol & strMethod & strEndPad
            .HTMLBody = .HTMLBody & strPad & "Reference: " & strPadCol & strRef & strEndPad
            .HTMLBody = .HTMLBody & strPad & "Payment Amount: " & strPadCol & strAmount & strEndPad
            ' Add any notes if they exist
            If Len(strNotes) > 0 Then
                .HTMLBody = .HTMLBody & strPad & "Notes: " & strPadCol & strNotes & strEndPad
            End If
            .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
                objOutlookRecip.Resolve
            Next
    
            ' Should we display the message before sending?
            '.SendUsingAccount = objOutlook.Session.Accounts.Item(4)
            If blnDisplayMsg Then
                .Display
            Else
                .Save
                .Send
            End If
            
            'Now update the record
            rs.Edit
            rs!EmailStatus = "Sent"
            rs!EmailDate = Date
            rs.Update
            
        End With

' Now get the next record
    
        rs.MoveNext

Loop



    ' Switch off the filter and release recordset object, and go back to record we were on
    Me.FilterOn = False
    DoCmd.GoToRecord , , acGoTo, lngCurrentRec
Proc_Exit:
    Set objOutlook = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
    Set objOutlookAttach = Nothing
    Set rs = Nothing
    Set rsCW = Nothing
    Set db = Nothing
    Exit Sub
    
Err_Handler:
    MsgBox Err.Number & " " & Err.Description
    Resume Proc_Exit



End Sub

Private Sub cmdRequery_Click()
    Dim lngId As Long
    Dim rst As Recordset
    Dim strCriteria As String
    
    ' Save record so requery on subform will pick up all last record written
    If Me.Dirty Then Me.Dirty = False
    lngId = Me.ID
    Me.Requery
    strCriteria = "ID=" & lngId
    Set rst = Me.sfrmEmails.Form.Recordset

    ' Requery the subform
    Me.sfrmEmails.Form.Requery
    ' Go back to record we were on
    Me.Recordset.FindFirst strCriteria
    ' Now the sub form
    rst.FindFirst strCriteria
    Set rst = Nothing
End Sub
 
I'm not totally clear on the question, but as a rule I wouldn't open the recordset on a form, I'd open it on an SQL statement that returned the desired records in the desired order. That would let you update them as well.
 
pbaldy said:
I'm not totally clear on the question, but as a rule I wouldn't open the recordset on a form, I'd open it on an SQL statement that returned the desired records in the desired order. That would let you update them as well.
Click to expand...

Sorry, had a blank moment there. :(
I was thinking that the SELECT would be read only and that I would have to have another UPDATE query to update the table.

Thanks for setting me straight.
 
You must log in or register to reply here.

Similar threads

J
Error 438 - Object doesn't support this property or method
Replies
8
Views
1,100
JohnPapa
J
N
Solved Send email from ms access vbs from another email address?
Replies
4
Views
1,466
Gasman
Gasman
M
MS Access VBA Loop Not working
Replies
11
Views
1,717
MatthewM
M
O
Sending Multiple Records Via Outlook Using Html In Access, Access 2013
Replies
2
Views
1,352
Cronk
Cronk
L
Email to particular recipients
2
Replies
25
Views
2,315
pbaldy
pbaldy

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom