nianchi111
Board Regular
- Joined
- Aug 24, 2007
- Messages
- 197
- Office Version
- 365
Hi,
I have a code for sending email in lotus notes. It creates the mail id, subject and body of mail however the mail is not sent from my mailbox. Please help me.
Sub Send_Excel_Cell_Content_To_Lotus_Notes()
Dim Notes As Object
Dim vaRecipient As Variant, vaMsg As Variant, vabody As Variant
Dim db As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim UserName As String
Dim MailDbName As String
Set Notes = CreateObject("Notes.NotesSession")
UserName = "Johnallsec@123"
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set db = Notes.GETDATABASE(vbNullString, MailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
UserName = "Johnallsec@123"
Call WorkSpace.ComposeDocument(, , "Memo")
Set UIdoc = WorkSpace.CurrentDocument
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant, stAttachment As String
'If cells are null, such as email address, cc, etc, then ignore and dont paste into email
On Error Resume Next
'Copy the email address from cell BY3 into the TO: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon.
'Please change your current sheet's name from "LookUp List" to your sheet's name
Recipient = Sheets("Sheet1").Range("A1").Value
Call UIdoc.FieldSetText("EnterSendTo", Recipient)
'Copy the email address from cell BY4 into the CC: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon
ccRecipient = Sheets("Sheet1").Range("A1").Value
Call UIdoc.FieldSetText("EnterCopyTo", ccRecipient)
'Copy the email address from cell BY5 into the BCC: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon
bccRecipient = Sheets("Sheet1").Range("A1").Value
Call UIdoc.FieldSetText("EnterBlindCopyTo", bccRecipient)
'Copy the subject from cell BY6 into the SUBJECT: field in Lotus Notes
Subject1 = Sheets("Sheet1").Range("A2").Value
Call UIdoc.FieldSetText("Subject", Subject1)
'Copy the cells in the range (one column going down) into the BODY in Lotus Notes.
'You must set the last cell BY18 to one cell below the range you wish to copy.
Call UIdoc.GotoField("Body")
'Body1 = Replace(Join(Application.Transpose(Sheets("LookUp Lists").Range([by9], [by18].End(3))), "@") & "@@Thank you,", "@", vbCrLf)
Body1 = Replace(Join(Application.Transpose(Range([a9], [a18].End(3))), "@") & "@@Thank you,", "@", vbCrLf)
Sheets("sheet1").Activate
ActiveCell.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Call UIdoc.Paste(Body1)
Call UIdoc.InsertText(Body1)
'Insert some carriage returns at the end of the email
Call UIdoc.InsertText(vbCrLf & vbCrLf)
Application.CutCopyMode = False
Set UIdoc = Nothing: Set WorkSpace = Nothing
Set db = Nothing: Set Notes = Nothing
'MailDoc.SAVEMESSAGEONSEND = True
'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(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
.Body = vaMsg
.SAVEMESSAGEONSEND = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
MsgBox "The e-mail has successfully been created and distributed.", vbInformation
End Sub
I have a code for sending email in lotus notes. It creates the mail id, subject and body of mail however the mail is not sent from my mailbox. Please help me.
Sub Send_Excel_Cell_Content_To_Lotus_Notes()
Dim Notes As Object
Dim vaRecipient As Variant, vaMsg As Variant, vabody As Variant
Dim db As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim UserName As String
Dim MailDbName As String
Set Notes = CreateObject("Notes.NotesSession")
UserName = "Johnallsec@123"
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set db = Notes.GETDATABASE(vbNullString, MailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
UserName = "Johnallsec@123"
Call WorkSpace.ComposeDocument(, , "Memo")
Set UIdoc = WorkSpace.CurrentDocument
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant, stAttachment As String
'If cells are null, such as email address, cc, etc, then ignore and dont paste into email
On Error Resume Next
'Copy the email address from cell BY3 into the TO: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon.
'Please change your current sheet's name from "LookUp List" to your sheet's name
Recipient = Sheets("Sheet1").Range("A1").Value
Call UIdoc.FieldSetText("EnterSendTo", Recipient)
'Copy the email address from cell BY4 into the CC: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon
ccRecipient = Sheets("Sheet1").Range("A1").Value
Call UIdoc.FieldSetText("EnterCopyTo", ccRecipient)
'Copy the email address from cell BY5 into the BCC: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon
bccRecipient = Sheets("Sheet1").Range("A1").Value
Call UIdoc.FieldSetText("EnterBlindCopyTo", bccRecipient)
'Copy the subject from cell BY6 into the SUBJECT: field in Lotus Notes
Subject1 = Sheets("Sheet1").Range("A2").Value
Call UIdoc.FieldSetText("Subject", Subject1)
'Copy the cells in the range (one column going down) into the BODY in Lotus Notes.
'You must set the last cell BY18 to one cell below the range you wish to copy.
Call UIdoc.GotoField("Body")
'Body1 = Replace(Join(Application.Transpose(Sheets("LookUp Lists").Range([by9], [by18].End(3))), "@") & "@@Thank you,", "@", vbCrLf)
Body1 = Replace(Join(Application.Transpose(Range([a9], [a18].End(3))), "@") & "@@Thank you,", "@", vbCrLf)
Sheets("sheet1").Activate
ActiveCell.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Call UIdoc.Paste(Body1)
Call UIdoc.InsertText(Body1)
'Insert some carriage returns at the end of the email
Call UIdoc.InsertText(vbCrLf & vbCrLf)
Application.CutCopyMode = False
Set UIdoc = Nothing: Set WorkSpace = Nothing
Set db = Nothing: Set Notes = Nothing
'MailDoc.SAVEMESSAGEONSEND = True
'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(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
.Body = vaMsg
.SAVEMESSAGEONSEND = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
MsgBox "The e-mail has successfully been created and distributed.", vbInformation
End Sub