Lotus Notes not saving e-mail to Sent folder

[John]

I'm stumped on this one. I've been all over the Internet looking for a
solution as to why this code refuses to save the sent e-mail in the Lotus
Notes Sent folder. This is mostly borrowed code, so kudos to the creator, but
I'm lost on how to get it to work for my purposes.

Thanks!

Sub SendEmail(EmailAddress As Variant)
Application.ScreenUpdating = False

'******************************************************************************
' Code Created 01/20/2004, MEMSr.
' This Module was created so the end-user can automatically save as an Excel
' file after report is refreshed. The Excel document is then attached to
Lotus
' Notes and an email is sent to their inbox for review. After review the
Excel
' document can be forward to additional recipents. Note: You must have Lotus
' Notes loaded on the local machine in order to run the macro. Also, you will
' need to have the Lotus Notes Library Reference added to the vb editor before
' the code will compile
'******************************************************************************
Dim EmailRow
Dim strBOdocument As String
Dim strBOUserDocsPath As String
Dim Family As String
Dim Div As String
Dim Counter As Boolean
Dim strAttachment As String
Dim DateTime As String
Dim SaveIt As Boolean

Counter = False

Dim domSession As New Domino.NotesSession
Dim domNotesDBMailFile As Domino.NotesDatabase
Dim domNotesDocumentMemo As Domino.NotesDocument
Dim domNotesRichText As Domino.NotesRichTextItem

'Set path for attachment
strBOUserDocsPath = "J:\OD Team Shared Drive\PM\PP&D\PP&D Tracking &
Reporting\HRBP"
DateTime = Sheets("Data").Range("B5")
strBOUserDocsPath = strBOUserDocsPath & "\" & DateTime & "\"

'Get Lotus Notes Password
If EmailPW = "" Then
EmailPW = InputBox("Please enter your Lotus Notes password:")
End If

domSession.Initialize (EmailPW)

For X = 1 To 100 Step 1

Set domNotesDBMailFile = domSession.GetDatabase("", "names.nsf")
Set domNotesDocumentMemo = domNotesDBMailFile.CreateDocument
Call domNotesDocumentMemo.AppendItemValue("Form", "Memo")
Call domNotesDocumentMemo.AppendItemValue("Importance", "1")
On Error GoTo Step1
'Loop until array is not blank
If EmailAddress(X) = "" Then GoTo Step1

'Check if Attachement Exsists

Call domNotesDocumentMemo.AppendItemValue("SendTo", EmailAddress(X))

'Find Attachement
LastRow = Sheets("Data").Range("H65536").End(xlUp).Row
With Sheets("Data").Range("H5", "H" & LastRow)
EmailFind = EmailAddress(X)
Set c = .Find(What:=EmailAddress(X), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=True)
If Not c Is Nothing Then
strBOdocument = Sheets("Data").Range("G" & c.Row)
strBOdocument = UCase(strBOdocument) & "_" & DateTime & ".xls"
Else
GoTo Step1
End If
End With

strAttachment = strBOUserDocsPath & strBOdocument
FileTest = File_Exists(strAttachment)
If FileTest = False Then GoTo Step1

'Create body of email
Call domNotesDocumentMemo.AppendItemValue("Subject", " ACT: Year-End
Performance Appraisals")
Set domNotesRichText = domNotesDocumentMemo.CreateRichTextItem("Body")
domNotesRichText.AppendText ("Attached is a report highlighting
Employees within your area(s) with incomplete Year-End Performance
Appraisals.")
domNotesRichText.AppendText (" This report indicates a paper-based,
Year-End Performance Appraisal has not been received by our HR Operations
team.")
domNotesRichText.AppendText (" If you have already submitted the
Year-End Performance Appraisal, please allow one to two weeks for them to be
validated and removed from this report.")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("The Year-End Performance Appraisal is a
critical element of Personal Performance & Development (PP&D) that supports
TD Bank's performance and development culture.")
domNotesRichText.AppendText (" In support of a consistent, positive
Employee experience our goal is 100% completion.")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Actions:")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Review the attached report and follow up
with Managers regarding incomplete Year-End Performance Appraisals")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Ensure Managers have all Year-End
Performance Appraisals submitted to you no later than January 31st")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Ensure you have all Year-End Performance
Appraisals submitted to Centralized Processing no later than February 5th")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Contact Grace Parascando at 856-533-7256,
with any questions concerning this report")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Contact Christopher Leady at 856-533-7227,
with any question regarding PP&D")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Thank you for your continued support!")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine

Label2:
On Error GoTo 0
'Attach file
Call domNotesRichText.EmbedObject(EMBED_ATTACHMENT, "", strAttachment, "")
'Send E-mail
SaveIt = True

With domNotesDocumentMemo
.SaveMessageOnSend = True
' .PostedDate = Now()
.Send (True)
End With

Step1:
Next X

Application.ScreenUpdating = True
End Sub

 

[Libby]

Hi John,

I send mails in Lotus Notes from excel using the following function and
successfully keep a copy in sent items.
Perhaps you could see if it helps?

Function SendMail()
Dim LotusNotesSession As Object
Dim LotusNotesMailFile As Object
Dim LotusNotesDocument As Object
Dim LotusNotesField As Object

''Get Connection to Notes
Set LotusNotesSession = CreateObject("Notes.NotesSession")

'get Connection to Mail File
Set LotusNotesMailFile = LotusNotesSession.GETDATABASE("", "")

''Open Mail
LotusNotesMailFile.OPENMAIL

'Create New Memo
Set LotusNotesDocument = LotusNotesMailFile.CREATEDOCUMENT

'Create 'Subject Field'
Set LotusNotesField = LotusNotesDocument.APPENDITEMVALUE("Subject", mySubject)

'Create 'Send To' Field
Set LotusNotesField = LotusNotesDocument.APPENDITEMVALUE("SendTo",
EMailSendTo)

'Create 'Copy To' Field
Set LotusNotesField = LotusNotesDocument.APPENDITEMVALUE("CopyTo", EMailCCTo)

'Create 'Blind Copy To' Field
Set LotusNotesField = LotusNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)

''Create 'Body' of memo
Set LotusNotesField = LotusNotesDocument.CREATERICHTEXTITEM("Body")

With LotusNotesField
.appendtext txtBody
.addnewline 4
.appendtext Me.txtSign.Text '"This email has been generated by an
automated process."
End With
'Attach the file --1454 indicate a file attachment
LotusNotesField = LotusNotesField.EMBEDOBJECT(1454, "", "C:\Temp\test.xls")
LotusNotesField = LotusNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)

LotusNotesDocument.savemessageonsend = True
LotusNotesDocument.Posteddate = Now()
LotusNotesDocument.Send (0)

Set LotusNotesSession = Nothing
Set bjNotesSession = Nothing
Set LotusNotesMailFile = Nothing
Set LotusNotesDocument = Nothing
Set LotusNotesField = Nothing

''Set return code
SendMail = true
End Function

 

[mohitstellar]

John wrote on 01/13/2010 15:59 ET

I'm stumped on this one. I've been all over the Internet looking for
solution as to why this code refuses to save the sent e-mail in the Lotu
Notes Sent folder. This is mostly borrowed code, so kudos to the creator, bu
I'm lost on how to get it to work for my purposes

Thanks

Sub SendEmail(EmailAddress As Variant
Application.ScreenUpdating = Fals

'*****************************************************************************
' Code Created 01/20/2004, MEMSr
' This Module was created so the end-user can automatically save as an Exce
' file after report is refreshed. The Excel document is then attached t
Lotu
' Notes and an email is sent to their inbox for review. After review th
Exce
' document can be forward to additional recipents. Note: You must hav Lotu
' Notes loaded on the local machine in order to run the macro. Also, yo wil
' need to have the Lotus Notes Library Reference added to the vb edito befor
' the code will compil
'*****************************************************************************
Dim EmailRo
Dim strBOdocument As Strin
Dim strBOUserDocsPath As Strin
Dim Family As Strin
Dim Div As Strin
Dim Counter As Boolea
Dim strAttachment As Strin
Dim DateTime As Strin
Dim SaveIt As Boolea

Counter = Fals

Dim domSession As New Domino.NotesSessio
Dim domNotesDBMailFile As Domino.NotesDatabas
Dim domNotesDocumentMemo As Domino.NotesDocumen
Dim domNotesRichText As Domino.NotesRichTextIte

'Set path for attachmen
strBOUserDocsPath = "J:OD Team Shared DrivePMPP&DPP&D Trackin

ReportingHRBP
DateTime = Sheets("Data").Range("B5"
strBOUserDocsPath = strBOUserDocsPath & "" & DateTime
"

'Get Lotus Notes Passwor
If EmailPW = "" The
EmailPW = InputBox("Please enter your Lotus Notes password:"
End I

domSession.Initialize (EmailPW

For X = 1 To 100 Step

Set domNotesDBMailFile = domSession.GetDatabase(""
"names.nsf"
Set domNotesDocumentMemo = domNotesDBMailFile.CreateDocumen
Call domNotesDocumentMemo.AppendItemValue("Form", "Memo"
Call domNotesDocumentMemo.AppendItemValue("Importance"
"1"
On Error GoTo Step
'Loop until array is not blan
If EmailAddress(X) = "" Then GoTo Step

'Check if Attachement Exsist

Call domNotesDocumentMemo.AppendItemValue("SendTo", EmailAddress(X)

'Find Attachemen
LastRow = Sheets("Data").Range("H65536").End(xlUp).Ro
With Sheets("Data").Range("H5", "H"
LastRow
EmailFind = EmailAddress(X
Set c = .Find(What:=EmailAddress(X), LookIn:=xlValues,
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=True, SearchFormat:=True
If Not c Is Nothing The
strBOdocument = Sheets("Data").Range("G" & c.Row
strBOdocument = UCase(strBOdocument) & "_" & DateTime
".xls
Els
GoTo Step
End I
End Wit

strAttachment = strBOUserDocsPath & strBOdocumen
FileTest = File_Exists(strAttachment
If FileTest = False Then GoTo Step

'Create body of emai
Call domNotesDocumentMemo.AppendItemValue("Subject", " ACT
Year-En
Performance Appraisals"
Set domNotesRichText
domNotesDocumentMemo.CreateRichTextItem("Body"
domNotesRichText.AppendText ("Attached is a report highlightin
Employees within your area(s) with incomplete Year-End Performanc
Appraisals."
domNotesRichText.AppendText (" This report indicates a paper-based
Year-End Performance Appraisal has not been received by our HR Operation
team."
domNotesRichText.AppendText (" If you have already submitted th
Year-End Performance Appraisal, please allow one to two weeks for them to b
validated and removed from this report."
domNotesRichText.AddNewLin
domNotesRichText.AddNewLin
domNotesRichText.AppendText ("The Year-End Performance Appraisal is
critical element of Personal Performance & Development (PP&D) tha
support
TD Bank's performance and development culture."
domNotesRichText.AppendText (" In support of a consistent, positiv
Employee experience our goal is 100% completion.")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Actions:")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Review the attached report and follow up
with Managers regarding incomplete Year-End Performance Appraisals")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Ensure Managers have all Year-End
Performance Appraisals submitted to you no later than January 31st")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Ensure you have all Year-End Performance
Appraisals submitted to Centralized Processing no later than February
5th")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Contact Grace Parascando at 856-533-7256,
with any questions concerning this report")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Contact Christopher Leady at 856-533-7227,
with any question regarding PP&D")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AppendText ("Thank you for your continued support!")
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine
domNotesRichText.AddNewLine

Label2:
On Error GoTo 0
'Attach file
Call domNotesRichText.EmbedObject(EMBED_ATTACHMENT, "",
strAttachment, "")
'Send E-mail
SaveIt = True

With domNotesDocumentMemo
.SaveMessageOnSend = True
' .PostedDate = Now()
.Send (True)
End With

Step1:
Next X

Application.ScreenUpdating = True
End Sub

The reason why Lotus Notes is not saving your emails in Sent Folder is because
Lotus Notes NSF File in Sent Folder has gone corrupt & needs repair in order
to save a copy in Sent Folder.
Here you can try <b>Stellar Lotus Notes Recovery</b> Software which
is an excellent software to repair corrupt NSF file and recovers all emails,
calendar entries, notes, tasks, journals, attachments and address books.
<b>Lotus Notes Recovery</b> software is an advanced and powerful
tool which scans, repairs nsf files & performs quick recovery of corrupted
NSF file components.