Send a Range as rich text in body through lotus notes

Sunny k

New Member
Joined
Jan 3, 2011
Messages
6
<TABLE style="WIDTH: 144pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=192 border=0><COLGROUP><COL style="WIDTH: 48pt" span=3 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD class=xl65 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #d99795" width=64 height=17>Name</TD><TD class=xl65 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #d99795" width=64>Id</TD><TD class=xl65 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #d99795" width=64>City</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>a</TD><TD class=xl64 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">111</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">WA</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>b</TD><TD class=xl64 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">134</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">DC</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>c</TD><TD class=xl64 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">145</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">VA</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>d</TD><TD class=xl64 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">156</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">CA</TD></TR></TBODY></TABLE>

hi all

need your help . i need a code which can send a range in the body of mail in lotus notes with formatting like if i select a range given above it should be copied as paste sepcial as richtext in the body of email. so that the user can copy the text .

thanks
 
Hi everyone,
I need to send my collection as a table in mail using lotus notes.Please help me
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Hi everyone,
I need to send my collection as a table in mail using lotus notes.Please help me

Did you see my reply earlier in this thread?
I'm glad you found the code useful. The code in post #9 of this thread (http://www.mrexcel.com/forum/excel-...ext-body-through-lotus-notes.html#post2762262) uses a temporary Word document as an intermediate object to copy and paste the Excel cells into the Notes email as a table. This means the table contents are editable in the recipient's and sender's email. It also retains most of the Excel cell formatting; the only cell format not retained seems to be the cell border.
See if that does what you want.
 
Upvote 0
Hi John_w,
(i need use <acronym title="vBulletin" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">vb</acronym>.net code).
can you please tell me how to send my collection as a data table using lotus notes.
i am new to this platform.
can you please tell me step by step briefly?
what steps i need to take to finish this task?
 
Upvote 0
Thanks John for providing this code, it is very much appreciated. Apart, from selecting or providing the cell value manually to be copied in body of the mail, is it possible to select the data automatically which are having values, because I have provided the range from a sheet and on that sheet there are formulas due to which in some cells data were not present and every time it is not possible to change the macros and also I have some questions on some coding where I have mentioned the questions, just check it out. If possible then please help me. Other than that Once again thank you very much.

Public Sub Send_Lotus_Email3()

Const EMBED_ATTACHMENT = 1454

Dim NSession As Object
Dim NWorkspace As Object
Dim NMailDb As Object
Dim NUIDocument As Object
Dim NRTattachment As Object
Dim Subject As String
Dim SendTo As String, CopyTo As String
Dim attachmentFile As String
Dim embedCells As Range

'------------ User-defined settings section ------------

SendTo = Sheets("SUMMARY").Range("A6")
CopyTo = Sheets("SUMMARY").Range("A7")

Subject = Sheets("SUMMARY").Range("D1")

'The cells to be embedded in the email body
Set embedCells = Sheets("SUMMARY").Range("C1:D40") "HERE DUE TO FORUMULA SOME TIMES DATA WERE NOT PRESENT IN ALL CELLS. IS IT POSSIBLE TO AUTO SELECT THE CELLS WHICH ARE HAVING VALUES.

'Optional file attachment - full folder path and file name, or "" for no attachment
attachmentFile = "C:\path\to\file.xls"
attachmentFile = ""

'------------ End of user-defined settings ------------

Set NSession = CreateObject("Notes.NotesSession") 'OLE, late binding only
Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")

Set NMailDb = NSession.GetDatabase("", "")
NMailDb.OpenMail

NWorkspace.ComposeDocument , , "Memo"

Set NUIDocument = NWorkspace.CurrentDocument

With NUIDocument
.FieldSetText "EnterSendTo", SendTo
.FieldSetText "EnterCopyTo", CopyTo
.FieldSetText "EnterBlindCopyTo", ""
.FieldSetText "Subject", Subject
.GotoField "Body"

'------------ Start of email body text ------------

.InsertText "you can delete it and write the message here." HERE IS IT POSSIBLE TO ASSIGN SOME CELL VALUE

'Copy and paste Excel cells as a bitmap image into the email body

.InsertText vbLf & vbLf & " " & vbLf & vbLf
embedCells.CopyPicture , xlBitmap
.Paste
Application.CutCopyMode = False

.InsertText vbLf & vbLf & "Write your extra comments here or delete this line" & vbLf & vbLf

'------------ End of email body text ------------

'Optional file attachment

If attachmentFile <> "" Then
Set NRTattachment = .Document.CreateRichTextItem("Attachment")
NRTattachment.EmbedObject EMBED_ATTACHMENT, "", attachmentFile
End If

.Save
.Close
End With

'Send S key to click the 'Send and Save' button to send mail document

Application.Wait DateAdd("s", 2, Now)
AppActivate "Send Mail", False
SendKeys "S"

Set NUIDocument = Nothing
Set NWorkspace = Nothing
Set NMailDb = Nothing
Set NSession = Nothing

End Sub
 
Upvote 0
is it possible to select the data automatically which are having values, because I have provided the range from a sheet and on that sheet there are formulas due to which in some cells data were not present and every time it is not possible to change the macros and also I have some questions on some coding where I have mentioned the questions
Based on my previous code, so you'll have to amend the ranges etc. for your requirements, try this:

VBA Code:
Public Sub Send_Lotus_Email3_Non_Blank()

    Const EMBED_ATTACHMENT = 1454
   
    Dim NSession As Object
    Dim NWorkspace As Object
    Dim NMailDb As Object
    Dim NUIDocument As Object
    Dim NRTattachment As Object
    Dim Subject As String
    Dim SendTo As String, CopyTo As String
    Dim attachmentFile As String
    Dim embedCells As Range
    Dim embedCellsArea As Range
   
    '------------ User-defined settings section ------------
   
    SendTo = "email1@address.com,email2@address.com"
    CopyTo = "email3@address.com"
   
    Subject = "Email subject"
   
    'The non-blank cells in the specified range will be embedded in the email body
   
    Set embedCells = Worksheets("Sheet1").Range("A1:E6")
    Set embedCells = Union(embedCells.SpecialCells(xlCellTypeConstants), embedCells.SpecialCells(xlCellTypeFormulas))
   
    'Optional file attachment - full folder path and file name, or "" for no attachment
   
    attachmentFile = "C:\path\to\file.xls"
    attachmentFile = ""
   
    '------------ End of user-defined settings ------------
   
    Set NSession = CreateObject("Notes.NotesSession")   'OLE, late binding only
    Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")
   
    Set NMailDb = NSession.GetDatabase("", "")
    NMailDb.OpenMail
       
    NWorkspace.ComposeDocument , , "Memo"
   
    Set NUIDocument = NWorkspace.CurrentDocument
       
    With NUIDocument
        .FieldSetText "EnterSendTo", SendTo
        .FieldSetText "EnterCopyTo", CopyTo
        .FieldSetText "EnterBlindCopyTo", ""
        .FieldSetText "Subject", Subject
        .GotoField "Body"
       
        '------------ Start of email body text ------------
       
        .InsertText "Start of email body text."
       
        'Copy and paste Excel cells as multiple bitmap images into the email body
       
        .InsertText vbLf & vbLf & "Excel cells as bitmap images:" & vbLf & vbLf
       
        For Each embedCellsArea In embedCells.Areas
            embedCellsArea.CopyPicture , xlBitmap
            .Paste
            Application.CutCopyMode = False
            DoEvents
        Next
       
        .InsertText vbLf & vbLf & Worksheets("Sheet1").Range("A10").Value & vbLf & vbLf   'Put cell A10 in email body
   
        '------------ End of email body text ------------
   
        'Optional file attachment
       
        If attachmentFile <> "" Then
            Set NRTattachment = .Document.CreateRichTextItem("Attachment")
            NRTattachment.EmbedObject EMBED_ATTACHMENT, "", attachmentFile
        End If
       
        .Save
        .Close
    End With
   
    'Send S key to click the 'Send and Save' button to send mail document
   
    Application.Wait DateAdd("s", 2, Now)
    AppActivate "Send Mail", True
    SendKeys "S"
   
    Set NUIDocument = Nothing
    Set NWorkspace = Nothing
    Set NMailDb = Nothing
    Set NSession = Nothing

End Sub
 
Last edited:
Upvote 0
Thanks once again John you are just WOW.

John, still the problem is existing, instead of pasting only those cells which are having data, all cells were copied like this.

TRANSACTION DATETRANSACTIONS
26-Aug-2019FD - INR 30,000,000.00FD - INR 140,000,000.00
20-Aug-2019RTGS - INR 44,750,000RTGS - INR 4,470,000RTGS - INR 11,000,000
13-Aug-2019RTGS - INR 5,000,000RTGS - INR 10,000,000
9-Aug-2019RTGS INR 15,000,000
19-Aug-2019RTGS INR 4,18,00,000
20-Aug-2019RTGS INR 84,75,000


I want to copy only those cells which are having data only. So, is it possible.
 
Upvote 0
Thanks once again John you are just WOW.

John, still the problem is existing, instead of pasting only those cells which are having data, all cells were copied like this.

TRANSACTION DATETRANSACTIONS
26-Aug-2019FD - INR 30,000,000.00FD - INR 140,000,000.00
20-Aug-2019RTGS - INR 44,750,000RTGS - INR 4,470,000RTGS - INR 11,000,000
13-Aug-2019RTGS - INR 5,000,000RTGS - INR 10,000,000
9-Aug-2019RTGS INR 15,000,000
19-Aug-2019RTGS INR 4,18,00,000
20-Aug-2019RTGS INR 84,75,000

I want to copy only those cells which are having data only. So, is it possible.
Dear John,

I have modified the code like this as below, now it is giving me option to edit and delete the extra rows, but still I need is that it should copy and paste those rows only which are having the following types of data.
Public Sub Send_Lotus_Email3()

Const EMBED_ATTACHMENT = 1454

Dim NSession As Object
Dim NWorkspace As Object
Dim NMailDb As Object
Dim NUIDocument As Object
Dim NRTattachment As Object
Dim Subject As String
Dim SendTo As String, CopyTo As String, BODYeX As String
Dim attachmentFile As String
Dim embedCells As Range
Dim embedCellsArea As Range


'------------ User-defined settings section ------------

SendTo = Sheets("SUMMARY").Range("E2")
CopyTo = Sheets("SUMMARY").Range("F2")

Subject = Sheets("SUMMARY").Range("B7")
BODYeX = Sheets("SUMMARY").Range("B13")


'The cells to be embedded in the email body

Set embedCells = Worksheets("SUMMARY").Range("C1:D50")

'Optional file attachment - full folder path and file name, or "" for no attachment
attachmentFile = "C:\path\to\file.xls"
attachmentFile = ""

'------------ End of user-defined settings ------------

Set NSession = CreateObject("Notes.NotesSession") 'OLE, late binding only
Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")

Set NMailDb = NSession.GetDatabase("", "")
NMailDb.OpenMail

NWorkspace.ComposeDocument , , "Memo"

Set NUIDocument = NWorkspace.CurrentDocument

With NUIDocument
.FieldSetText "EnterSendTo", SendTo
.FieldSetText "EnterCopyTo", CopyTo
.FieldSetText "EnterBlindCopyTo", ""
.FieldSetText "Subject", Subject
.GotoField "Body"

'------------ Start of email body text ------------

.InsertText " ", BODYeX

'Copy and paste Excel cells as a bitmap image into the email body

Sheets("SUMMARY").Range("C1:D50").Copy 'CHANGE THIS
.Paste
Application.CutCopyMode = False


End With


Set NUIDocument = Nothing
Set NWorkspace = Nothing
Set NMailDb = Nothing
Set NSession = Nothing

End Sub
 
Upvote 0
Dear John,

I have modified the code like this as below, now it is giving me option to edit and delete the extra rows, but still I need is that it should copy and paste those rows only which are having the following types of data.
Public Sub Send_Lotus_Email3()

Const EMBED_ATTACHMENT = 1454

Dim NSession As Object
Dim NWorkspace As Object
Dim NMailDb As Object
Dim NUIDocument As Object
Dim NRTattachment As Object
Dim Subject As String
Dim SendTo As String, CopyTo As String, BODYeX As String
Dim attachmentFile As String
Dim embedCells As Range
Dim embedCellsArea As Range


'------------ User-defined settings section ------------

SendTo = Sheets("SUMMARY").Range("E2")
CopyTo = Sheets("SUMMARY").Range("F2")

Subject = Sheets("SUMMARY").Range("B7")
BODYeX = Sheets("SUMMARY").Range("B13")


'The cells to be embedded in the email body

Set embedCells = Worksheets("SUMMARY").Range("C1:D50")

'Optional file attachment - full folder path and file name, or "" for no attachment
attachmentFile = "C:\path\to\file.xls"
attachmentFile = ""

'------------ End of user-defined settings ------------

Set NSession = CreateObject("Notes.NotesSession") 'OLE, late binding only
Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")

Set NMailDb = NSession.GetDatabase("", "")
NMailDb.OpenMail

NWorkspace.ComposeDocument , , "Memo"

Set NUIDocument = NWorkspace.CurrentDocument

With NUIDocument
.FieldSetText "EnterSendTo", SendTo
.FieldSetText "EnterCopyTo", CopyTo
.FieldSetText "EnterBlindCopyTo", ""
.FieldSetText "Subject", Subject
.GotoField "Body"

'------------ Start of email body text ------------

.InsertText " ", BODYeX

'Copy and paste Excel cells as a bitmap image into the email body

Sheets("SUMMARY").Range("C1:D50").Copy 'CHANGE THIS
.Paste
Application.CutCopyMode = False


End With


Set NUIDocument = Nothing
Set NWorkspace = Nothing
Set NMailDb = Nothing
Set NSession = Nothing

End Sub
John one more thing, actually from cell C2:D50, there are formulas in the cells.
 
Upvote 0
Dear John,
Thanks a lot,
As of now I got one more assignment in which if we input the BIC SWIFT CODE then automatically the bank details will be fed in the respective cells from the website, so for this I am trying to figure it out and working on this code. Not getting the results as desired. If possible please help me.

Sub Scrape_Stats()
'Create Internet Explorer Browser
Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")

'Ask Browser to navigate to website (.Visible=False will hide IE when running)
With appIE
.Navigate "Validate SWIFT / BIC code - TransferWise"
.Visible = True
End With

'Have the macro pause while IE is busy opening and navigating
Do While appIE.Busy
DoEvents
Loop

'Designate the table to be extracted
Dim contentDiv As Object
Set contentDiv = appIE.Document.getElementById("placeholder")
Dim dataTable As Object
Set dataTable = contentDiv.getElementsByTagName("d-block")(1)

'Close IE and clear memory
appIE.Quit
Set appIE = Nothing

'Clear area and paste extracted text into the appropriate sheet/cells
Worksheets("Sheet1").Range("B2").ClearContents
Sheets("Sheet1").Select
Range("B2").Select
End Sub

Sub Scrape_Stats()
'Create Internet Explorer Browser
Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")

'Ask Browser to navigate to website (.Visible=False will hide IE when running)
With appIE
.Navigate "Validate SWIFT / BIC code - TransferWise"
.Visible = True
End With

'Have the macro pause while IE is busy opening and navigating
Do While appIE.Busy
DoEvents
Loop

'Designate the table to be extracted
Dim contentDiv As Object
Set contentDiv = appIE.Document.getElementById("placeholder")
Dim dataTable As Object
Set dataTable = contentDiv.getElementsByTagName("d-block")(1)

'Close IE and clear memory
appIE.Quit
Set appIE = Nothing

'Clear area and paste extracted text into the appropriate sheet/cells
Worksheets("Sheet1").Range("B2").ClearContents
Sheets("Sheet1").Select
Range("B2").Select
End Sub

BIC CodeBank NameLine2 AutoLine 3 AutoLine 4 Auto
AACIFRP1XXXABN AMRO COMMUNICATIONS INTERNATIONALESPARISFRANCE
 
Upvote 0
John one more thing, actually from cell C2:D50, there are formulas in the cells.
With this and your previous post I think I understand what you're asking for now.

Try this:

VBA Code:
    Dim lastCellRowNumber As Long
    With Worksheets("SUMMARY")
        'Last row in columns C:D, ignoring blanks and blank results of formulas
        Set embedCells = .Columns("C:D")
        lastCellRowNumber = .Evaluate("max(if(" & embedCells.Address & "<>"""",row(" & embedCells.Address & ")))")
        Set embedCells = .Range("C1:D" & lastCellRowNumber)
    End With
Insert the cells into the Notes email body like this (same as previously):
Code:
        embedCells.CopyPicture , xlBitmap
        .Paste
        Application.CutCopyMode = False
        DoEvents
PS use CODE tags when posting VBA code - the </> icon in the message editor.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top