Email lotus notes send sheet

[marreco]

hi...

How do I adapt this code so I can only send a portion of the worksheet.

Example Sheet1 A1: H23 ..

[VBA]Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object

Function SendMail()

On Error GoTo SendMailError

EMailSendTo = "geronimo_andrzejewski@embraco.com" '' Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional

''Establish Connection to Notes
Set objNotesSession = CreateObject("Notes.NotesSession")

''Establish Connection to Mail File
'' .GETDATABASE("SERVER", "FILE")
Set objNotesMailFile = objNotesSession.GetDatabase("", "")
''Open Mail
objNotesMailFile.OPENMAIL

''Create New Memo
Set objNotesDocument = objNotesMailFile.CreateDocument

''Create 'Subject Field'
Set objNotesField = objNotesDocument.AppendItemValue("Subject", EmailSubject)

''Create 'Send To' Field
Set objNotesField = objNotesDocument.AppendItemValue("SendTo", EMailSendTo)

''Create 'Copy To' Field
Set objNotesField = objNotesDocument.AppendItemValue("CopyTo", EMailCCTo)

''Create 'Blind Copy To' Field
Set objNotesField = objNotesDocument.AppendItemValue("BlindCopyTo", EMailBCCTo)

''Create 'Body' of memo
Set objNotesField = objNotesDocument.CreateRichTextItem("Body")

With objNotesField
.AppendText "This e-mail is generated by an automated process."
.AddNewLine 1
.AppendText "Please follow established contact procedures should"

'have any questions."
.AddNewLine 2
End With

objNotesField = objNotesField.EmbedObject(1454, "", ActiveWorkbook.FullName)

''Send the e-mail
objNotesDocument.Send (0)

''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing

''Set return code
SendMail = True

Exit Function

SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext

SendMail = False

End Function[/VBA]

[Kenneth Hobs]

IN the Body, you can Paste what you need. Change the Named range and use Selection.Copy rather than then rnBody part and the line before it.

[VBA]Option Explicit

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Sub Lotus_Formatted_Range_Into_Body()
Dim oWorkSpace As Object, oUIDoc As Object
Dim stTo As String, stCC As String, stSubject As String, stBody As String
Dim rnBody As Range
Dim lnRetVal As Long

'Lotus Notes must be running in order to get the Paste-function to work properly...
'Although the body has the focus it will not paste from the clip-board.
'Even if no formhead are in use it will not work.

lnRetVal = FindWindow("NOTES", vbNullString)

If lnRetVal = 0 Then
MsgBox "Lotus Notes must be open in order to execute this procedure.", vbInformation, "Systemerror - Lotus Notus"
Exit Sub
End If

Application.ScreenUpdating = False

Set oWorkSpace = CreateObject("Notes.NotesUIWorkspace")

stTo = "anyaddress@address.com"
stCC = "anyaddress@address.com"
stSubject = "Subject of the Message"
'stBody = "This shows up in the Message Body"

'In the active sheet a named range is used
Set rnBody = ActiveSheet.Range("under")
rnBody.Copy

On Error Resume Next
'The error-message "Unable to find Window" is a known bug and it generate different
'error-messages depending on which version (4.x / 5.x) that´s running.
'Make sure You have open the view "Post" and the use the command
'File | Database | Properties to find both the server and the maildatabase.
'Here are my settings without any Domino-server.
Set oUIDoc = oWorkSpace.COMPOSEDOCUMENT("Server_Name", "Database_Name.nsf", "Memo")
On Error GoTo 0

Set oUIDoc = oWorkSpace.CurrentDocument

Call oUIDoc.FIELDSETTEXT("EnterSendTo", stTo)
Call oUIDoc.FIELDSETTEXT("EnterCopyTo", stCC)
Call oUIDoc.FIELDSETTEXT("Subject", stSubject)
'Call oUIDoc.FieldSetText("Body", stBody)
Call oUIDoc.GoToField("Body")
Call oUIDoc.Paste

Call oUIDoc.Send(False)
Call oUIDoc.Save(True, False, False)
Call oUIDoc.Close

Set oUIDoc = Nothing

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

MsgBox "The e-mail have been created, saved but not sent.", vbInformation

AppActivate "Notes"
End Sub[/VBA]

[marreco]

hi..


Thank you for answer me thank you!

I will test but thanks anyway!

[shrivallabha]

Visit this page if you need code for lotus notes almost customized to the last step:

http://www.rondebruin.nl/notes.htm