Send the content of a .xls plus a text to a list of Lotus notes users. Nearly there

[pironjulien]

Hi Everyone,

everyday I am populating a .xls file with data. I would like to send an email with the content of this file (as text preferably or as an attached picture in case it cannot be done) to the people who are listed in my column B. The users in column B are Lotus notes users identified.

When I am using the below code to send "Dear All, please take the necessary actions to update the below elements" I would like to add afterwards the pasted line of the range I selected but the system does not let me.

I will have more than one line in the file, hence more than one user to send the information to.

I believe my code does not work because of the bolded part. Can anyone please check and help. I have been trying different coding over the past few days and I remain unsuccesful.

THANK YOU A MILLION FOR YOUR HELP.


Sub Julienpiron1503()
Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim bodytext As Variant
Dim stSignature As String
Dim stringtext As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False


Sheets("Sheet1").Select
Range("A1:F1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
bodytext = Selection.Value


' Open and locate current LOTUS NOTES User
For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & x) = "Urgent action" Then
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)

' Select range of e-mail addresses
Recipient = Worksheets("Sheet1").Range("B" & x).Value
MailDoc.SendTo = Recipient
MailDoc.Subject = "Your urgent action required-Feedback bam kpi"
MailDoc.Body = "Dear All, please take the necessary actions to update the below elements" & bodytext & vbCrLf & vbCrLf & stSignature
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MsgBox "Congratulations! Email created"
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
.ScreenUpdating = True
.DisplayAlerts = True

errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
End If
Next x
End With
End Sub

[pironjulien]

anybody? Appreciate your help