Send Mail Using Lotus Notes With Active Sheet As Attachment Using Lotus Notes

[mams323]

Dear All,

I hope you are all doing well,

Kindly help me and provide me the code that will send the activesheet to someone email located in the same activesheet in the cell E9.
Please find the attached file wich inclue more details.

Your kind efforts appreciated in advance. :applause:

MSabra

[Excel Fox]

Instead of sending it as an attachment, are you fine with sending it as a part of the email body? The format and all will look exactly the same.

[mams323]

Instead of sending it as an attachment, are you fine with sending it as a part of the email body? The format and all will look exactly the same.




Dear Administrator,

Thank you for your kind reply.

Yes please, I want it to be as apart of the email body.

Thank you :)

[bakerman]

Sub Mail_Active_Sheet()

Application.DisplayAlerts = False
'path, name and extension for tempfile - change to suit
c00 = "G:\My documents\TempFile." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat
'Copy active sheet
ThisWorkbook.ActiveSheet.Copy
'Save attachment
With ActiveWorkbook
.SaveAs c00, c01
.Close False
End With
'Create mail
With CreateObject("Outlook.Application").createitem(0)
.to = ActiveSheet.Range("E9")
.Subject = ActiveSheet.Range("B2")
.attachments.Add c00
.display '.Send
End With
'Delete tempfile
Kill c00
Application.DisplayAlerts = True

End Sub

[mams323]

Thank you very much Bakerman!

Kindly be informed that I don't have Outlook application in my Computer! we are using another application called "Lotus Notes" if yo know it.
In this case how shall I modify the code to suit our mail application.

Thank you in advance

[Excel Fox]

Untested...


Sub SendLotusMail()

Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim c00 As String, c01

'path, name and extension for tempfile - change to suit
c00 = "G:\My documents\TempFile." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat
'Copy active sheet
ThisWorkbook.ActiveSheet.Copy
'Save attachment
With ActiveWorkbook
.SaveAs c00, c01
.Close False
End With

'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(1454, "", c00)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = ActiveSheet.Range("E9").Value
.Subject = ActiveSheet.Range("B2").Value
.Body = "Message Here"
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, ActiveSheet.Range("E9").Value
End With
Kill c00'Delete the temporary file
Exit Sub

ErrorMsg:

If Err.Number = 7225 Then
MsgBox "The file cannot be found in the location ", vbOKOnly, "Error"

ElseIf Err.Number = 5 Then
MsgBox "Please ensure that you are logged in to Lotus Notes", vbExclamation, "Lotus Notes"


ElseIf Err.Number = 8965 Then
MsgBox "User is not logged in or user ID file is in use elsewhere and cannot be modified."

Else
MsgBox Err.Number & Err.Description

End If

End Sub

[bakerman]

@ Sam
The attachment could also be removed afterwords by using Kill (if necessary)
Don't forget to release the objects from memory. ;)

[Excel Fox]

Right. Acknowledged that bakerman :D

[mams323]

Thank you Administrator for your kind efforts.

I still have a problem with the file name or path! please have a look to the picture hereunder:

925


for mor details about the problem I faced :


Sub SendLotusMail()

Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim c00 As String, c01

'path, name and extension for tempfile - change to suit
c00 = "D:\TempFile." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat
'Copy active sheet
ThisWorkbook.ActiveSheet.Copy
'Save attachment
With ActiveWorkbook
.SaveAs c00, c01 ‘ Here is the problem I faced
.Close False
End With

'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GetDatabase("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(1454, "", c00)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = ActiveSheet.Range("E9").Value
.Subject = ActiveSheet.Range("B2").Value
.Body = "Message Here"
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, ActiveSheet.Range("E9").Value
End With
Kill c00 'Delete the temporary file
Exit Sub

ErrorMsg:

If Err.Number = 7225 Then
MsgBox "The file cannot be found in the location ", vbOKOnly, "Error"

ElseIf Err.Number = 5 Then
MsgBox "Please ensure that you are logged in to Lotus Notes", vbExclamation, "Lotus Notes"


ElseIf Err.Number = 8965 Then
MsgBox "User is not logged in or user ID file is in use elsewhere and cannot be modified."

Else
MsgBox Err.Number & Err.Description

End If

End Sub


Please have a look to the attached file:
926

[bakerman]

Was the workbook you ran the code from already saved on HD or was it a new one ?
Because for me it works fine. Try this one

Sub tst()
c00 = "D:\TempFile." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat
MsgBox c00 & "," & c01
End Sub
In the messagebox you should see D:\Tempfile. then extension (xls,xlsm) then number (56,52)