Module editing

[hinchi1]

Hello
In my access database I have some modules which are for the automation of Outlook and it works fine, See below. However, on occasion the end user needs to change the content of the email body(in red) and the only way to do that is go in to the code. The end user is not so familiar with code, so is there a way to store the body of the email in a table? This way if the end user decides to change the email body they don't have to go through all the modules to make the changes. So if it is possible to store the email text in a table, how would/ could I reference the table from within the module(s)?

Public Sub SendSerialEmailNextMonth()


Dim db As DAO.Database
Dim rs As DAO.Recordset

Dim emailTo As String
Dim emailSubject As String
Dim emailText As String
'Dim acc As Outlook.Account
Dim acc As Object
'Dim outApp As Outlook.Application
Dim outApp As Object
'Dim outMail As Outlook.MailItem
Dim outMail As Object
Dim outlookStarted As Boolean




On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0

If outApp Is Nothing Then
'MsgBox "Outlook will open!!", vbOK
Shell "Outlook.exe", vbMaximizedFocus
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If


Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT FirstName, Surname, EmailAddress, DeskVacated, VacateDesk " & _
" FROM qryPGRDesks1FilterNextMonth WHERE EmailAddress IS NOT NULL")
Do Until rs.EOF


'emailTo = Trim(rs.Fields("FirstName").Value & " " & rs.Fields("Surname").Value) & _
" <" & rs.Fields("EmailAddress").Value & ">"
emailTo = Trim(rs.Fields("EmailAddress").Value)

emailSubject = "Notification to vacate desk"
If IsNull(rs.Fields("FirstName").Value) Then
emailSubject = emailSubject & " for " & _
rs.Fields("FirstName").Value & " " & rs.Fields("Surname").Value
End If

emailText = Trim("Hi " & rs.Fields("FirstName").Value) & vbCrLf & vbCrLf


emailText = emailText & _
"This email is to inform you that your desk needs to be vacated by " & rs.Fields("VacateDesk").Value & "." & " " & _
"Please contact the Faculty Infrastucture Team should you need to discuss this request." & " " & _
"Our email address is ?? <email here> " & vbCrLf & vbCrLf & _
"Best Regards " & vbCrLf & vbCrLf & _
"Faculty Infrastructure Team - Desk Allocation" & vbCrLf & _
"Extension Number: ###### "


Set outMail = outApp.CreateItem(0)
'With outMail
'.SentOnBehalfOfName = "email here"
'End With

'Set outMail = outApp.CreateItem(olMailItem)
Set acc = GetAccountByEmail(outApp, "email here")
If Not acc Is Nothing Then
Set outMail.SendUsingAccount = acc
End If

'Set outMail = outApp.CreateItem(olMailItem)
'outMail.SendUsingAccount = GetAccountByEmail(outApp, "email here")
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Send

rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set db = Nothing

'If outlookStarted Then
'outApp.Quit
'End If

Set outMail = Nothing
Set outApp = Nothing

End Sub

[pbaldy]

You could use a DLookup() or recordset to get the text from a table. Also, you could use

outMail.Display

instead of

outMail.Send

to let the user edit before sending.

[kd2017]

Also, you could use

outMail.Display

instead of

outMail.Send

to let the user edit before sending.

The only issue with that is that they are using a loop to send a bunch of emails so they'd have to edit the content for every loop.

I've modified the code to use a dlookup per pbaldy's suggestion (untested and dlookup parameters are just placeholders):

Public Sub SendSerialEmailNextMonth()
On Error GoTo ErrHandler
    
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String
    'Dim acc As Outlook.Account
    Dim acc As Object
    'Dim outApp As Outlook.Application
    Dim outApp As Object
    'Dim outMail As Outlook.MailItem
    Dim outMail As Object
    Dim outlookStarted As Boolean
    Dim emailBody As Variant
    
    
    'On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    'On Error GoTo 0
    
    If outApp Is Nothing Then
        'MsgBox "Outlook will open!!", vbOK
        Shell "Outlook.exe", vbMaximizedFocus
        Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If
    
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT FirstName, Surname, EmailAddress, DeskVacated, VacateDesk " & _
                              " FROM qryPGRDesks1FilterNextMonth WHERE EmailAddress IS NOT NULL")
                              
    If Not (rs.BOF And rs.EOF) Then
        rs.MoveFirst
        Do Until rs.EOF
            'emailTo = Trim(rs.Fields("FirstName").Value & " " & rs.Fields("Surname").Value) & _
            " <" & rs.Fields("EmailAddress").Value & ">"
            emailTo = Trim(rs.Fields("EmailAddress").Value)
            
            emailSubject = "Notification to vacate desk"
            
            If IsNull(rs.Fields("FirstName").Value) Then
                emailSubject = emailSubject & " for " & _
                rs.Fields("FirstName").Value & " " & rs.Fields("Surname").Value
            End If
            
            emailText = Trim("Hi " & rs.Fields("FirstName").Value) & vbCrLf & vbCrLf
            
            
            'emailText = emailText & _
            '"This email is to inform you that your desk needs to be vacated by " & rs.Fields("VacateDesk").Value & "." & " " & _
            '"Please contact the Faculty Infrastucture Team should you need to discuss this request." & " " & _
            '"Our email address is ?? <email here> " & vbCrLf & vbCrLf & _
            '"Best Regards " & vbCrLf & vbCrLf & _
            '"Faculty Infrastructure Team - Desk Allocation" & vbCrLf & _
            '"Extension Number: ###### "
            
            emailBody = DLookup("[FIELD NAME]", "[TABLE NAME]", "[OPTIONAL SEARCH CONDITION]")
            If Not IsNull(emailBody) Then
                emailText = emailText & emailBody
            Else
                Err.Raise 1001, , "Failed to locate email body."
            End If
            
            Set outMail = outApp.CreateItem(0)
            'With outMail
            '.SentOnBehalfOfName = "email here"
            'End With
            
            'Set outMail = outApp.CreateItem(olMailItem)
            Set acc = GetAccountByEmail(outApp, "email here")
            
            If Not acc Is Nothing Then
                Set outMail.SendUsingAccount = acc
            End If
            
            'Set outMail = outApp.CreateItem(olMailItem)
            'outMail.SendUsingAccount = GetAccountByEmail(outApp, "email here")
            outMail.To = emailTo
            outMail.Subject = emailSubject
            outMail.Body = emailText
            outMail.Send
            
            rs.MoveNext
        Loop
    End If
    
    rs.Close
    
ExitHandler:
    Set rs = Nothing
    Set db = Nothing
    
    'If outlookStarted Then
    'outApp.Quit
    'End If
    
    Set outMail = Nothing
    Set outApp = Nothing
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description, , Err.Number
    Resume ExitHandler

End Sub

[Gicu]

I think that you're still missing an important step. The text in the table holding the email text should contain some easily recognizable placeholders (I use pipe-delimited keywords like |DUE_DATE|, |OUR_EMAIL|, etc.
Then in your code you replace those place holders with the values from the recordset:

emailBody = DLookup("[FIELD NAME]", "[TABLE NAME]", "[OPTIONAL SEARCH CONDITION]")
emailbody=Replace(emailbody,"|DUE_DATE|", rs.Fields("VacateDesk"))
emailbody=Replace(emailbody,"|OUR_EMAIL|", rs.Fields("OurEmail"))
'.....any other info from recordset

Cheers,

[hinchi1]

Thanks for the suggestions but how do I put the email text in a table with placeholder references. This may be quite simple but having not used this method before I don't quite follow it. Thanks in advance.

[Gicu]

You create a new table in your back-end called tblEmailSettings or similar with a memo (long text) field. In a new form bound that that field you add a textbox big enough to show your text and set its text format property to rich text:https://support.microsoft.com/en-us/...c-9d8dca824630.

Now you copy and paste the body of the email from one of your VBA generated emails (the red one in the first post) in the form and replace the actual due date with a placeholder (like |VACATE_DESK_BY|).

Finally modify the original VBA code to replace the static message with the one from the table by retrieving it using a dlookup as shown; use replace to update the placeholder to the actual value for each record inside your loop.

Cheers,

[hinchi1]

Thanks for this, works a treat. One last thing, how can I highlight email addresses in the form textbox so they show up as hyperlinks in the email body?

[kd2017]

Instead of outMail.Body you'll want to use outMail.HTMLBody and you can format your email using HTML notation like this

outMail.HTMLBody = "This is an <a href='mailto:john@email.com'>example</a> html hyperlink"

replace [john@email.com] with your email address, and [example] with the text you want to display which in this case is also the email address.

For your reference:
https://docs.microsoft.com/en-us/off...litem.htmlbody
https://codekabinett.com/rdumps.php?...ss-vba-outlook