Within Lotus notes I have set up a dummy mail box to store emails sent and received from an access database. I have got my code to save a copy of sent emails to the dummy box, and have set up the outgoing email so that reply to is set to the dummy box, however the e mail says that it is sent from me, not the dummy box, so some of my recipients reply direct to me. Also any delivery failures are sent to my box, not the dummy box. How can I write my code so that the 'sent from' appears as the dummy box?
Code:
Sub TestDue()
'notes objects and variable for email addresses
Dim NotesDB As Object
Dim NotesDoc As Object
Dim NotesRTF As Object
Dim NotesSession As Object
Dim strsupportemail As String
'Dim avarattach(1) As Variant
Dim richStyle As Object
'database objects
Dim mydb As DAO.Database
Dim myquery As DAO.Recordset
' variables to check if the email addresses match
Dim currentemail As String
Dim Driver_Name As String
Dim regolist As String
Dim expdate As String
Dim RetVal As Variant
Dim Make As String
Dim Model As String
Dim Client As String
Dim KAM As String
RetVal = SysCmd(5) 'Clear Status Bar
Dim testcheck As Integer
On Error GoTo help:
'set the database objects to the email database
Set mydb = CurrentDb
Set myquery = mydb.OpenRecordset("WOF Email", dbOpenDynaset)
'check if the database has any records
If myquery.BOF Or myquery.EOF Then
MsgBox "There are no records"
Exit Sub
End If
testcheck = MsgBox("Is this a test?", vbYesNo)
'ensure we are at the first record
myquery.MoveFirst
Do Until myquery.EOF
'connect to the notes session -- notes must be open as I am not checking that it is or for a password
Set NotesSession = CreateObject("Notes.Notessession")
Set NotesDB = NotesSession.GetDatabase("", "names.nsf")
Set NotesDoc = NotesDB.CreateDocument
Call NotesDoc.ReplaceItemValue("BlindCopyTo", "[EMAIL="wof@leaseplan.co.nz"][COLOR=#417394]wof@leaseplan.co.nz[/COLOR][/EMAIL]")
Call NotesDoc.ReplaceItemValue("Form", "Memo")
Call NotesDoc.ReplaceItemValue("ReplyTo", "[EMAIL="wof@leaseplan.co.nz"][COLOR=#417394]wof@leaseplan.co.nz[/COLOR][/EMAIL]")
' 'get the email address of the current record then move to the next record
currentemail = myquery.Fields("email")
regolist = myquery.Fields("REGISTRATION")
expdate = myquery.Fields("WOFDate1")
Driver_Name = myquery.Fields("DriverName")
Make = myquery.Fields("MKDS")
Model = myquery.Fields("MDDS")
Client = myquery.Fields("CUSNAM")
KAM = myquery.Fields("CMCMNM")
'set the email address to contact if the email address is blank or JWT for Test
If testcheck <> 7 Then
strsupportemail = "[EMAIL="john_wallace-thexton@leaseplan.co.nz"][COLOR=#417394]john_wallace-thexton@leaseplan.co.nz[/COLOR][/EMAIL]"
Call NotesDoc.ReplaceItemValue("Subject", "Test - The Warrant of Fitness is about to expire on " & regolist)
Else
If currentemail <> "" Then
strsupportemail = currentemail
Call NotesDoc.ReplaceItemValue("Subject", "The Warrant of Fitness is about to expire on " & regolist)
Else
strsupportemail = "[EMAIL="wof@leaseplan.co.nz"][COLOR=#417394]wof@leaseplan.co.nz[/COLOR][/EMAIL]"
Call NotesDoc.ReplaceItemValue("Subject", "WOF Notification - No email address")
End If
End If
Call NotesDoc.ReplaceItemValue("Sendto", strsupportemail)
'create the body of the email
Set NotesRTF = NotesDoc.CreateRichTextItem("body")
'fill the body of the email -- it would be good to use style sheets
Call NotesRTF.AppendText("We would like to remind you that the Warrant of Fitness (WOF) or Certificate of Fitness (COF) on the following vehicle is due to expire shortly:")
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("Vehicle: " & vbTab)
Call NotesRTF.AppendText(regolist)
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AppendText("Expiry Date: " & vbTab)
Call NotesRTF.AppendText(expdate)
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AppendText("Current Driver: " & vbTab)
Call NotesRTF.AppendText(Driver_Name)
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AppendText("Make / Model: " & vbTab)
Call NotesRTF.AppendText(Make)
Call NotesRTF.AppendText(" ")
Call NotesRTF.AppendText(Model)
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("You have received this notification as your email address is listed against this vehicle. If this is incorrect, please ask your Fleet Administrator to advise us of the correct email address and pass a copy of this email on to the driver to action.")
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("As it is the responsibility of the driver to ensure that their vehicle always has a current WOF/COF and Registration, please ensure the WOF/COF is completed prior to the expiry date above. Please arrange a time with your local dealership or take the vehicle to your closest VTNZ Station. An online listing of these can be found at [URL="http://www.vtnz.co.nz/NearestStationSearch"][COLOR=#417394]http://www.vtnz.co.nz/NearestStationSearch[/COLOR][/URL]. Let them know that it is a LeasePlan managed vehicle so they know to contact our Maintenance Team for pre-approval. It may also be timely to check your windscreen for when the next service is due for your vehicle, in case the two can be combined at your local dealership.")
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("Our process is to check weekly with the New Zealand Transport Agency (NZTA) to see if the WOF/COF has been completed. Until we receive confirmation that the vehicle has passed inspection, we will continue to send reminder emails. ")
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("Please note")
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("*" & vbTab & "If a vehicle is due for registration, this cannot be purchased until the WOF/COF is completed. ")
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AppendText("*" & vbTab & "Any fines received are the responsibility of the driver to pay. These are usually around $200 per notice for unwarranted and/or unregistered vehicles.")
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AppendText("*" & vbTab & "In some instances, unwarranted vehicles will not be covered by insurance if they are involved in an accident/incident. ")
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("This is a system generated email, please do not reply. If you need further assistance, please call us on 0800 ")
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("Kind regards")
Call NotesRTF.AddNewLine(2)
Call NotesRTF.AppendText("Client Services Team")
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AppendText("Email sent to " & strsupportemail)
Call NotesRTF.AppendText(" on " & Now())
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AppendText("Client: " & Client)
Call NotesRTF.AddNewLine(1)
Call NotesRTF.AppendText("KAM/AM: " & KAM)
NotesDoc.Send (True)
'move to the next record
myquery.MoveNext
RetVal = SysCmd(4, "Progress: " & CInt((myquery.AbsolutePosition / myquery.RecordCount) * 100) & "%") 'Progress status bar update
Loop
RetVal = SysCmd(4, "Complete") 'Progress status bar update
'tidy up time
Set NotesSession = Nothing
Set mydb = Nothing
Set myquery = Nothing
' Create Hard Copy
Call CreateHardCopyDue
' Form_Email.Exit.SetFocus
' Form_Email.Command10.Enabled = False
Exit Sub
help:
MsgBox Err.Description
MsgBox Err.Source
MsgBox myquery.Fields("email")
Debug.Print
End Sub
