Hello everyone, I am working in excel 2003 and I created a button as to paste some cells into a new notes memo, I am unable to get a copy/paste special in HTML macro to paste into note 7. Here is some code i wrote up but was unable to get it to work, any ideas?
Sub Send_Excel_Cell_Content_To_Lotus_Notes()
’
Dim Notes As Object
Dim Maildb As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim UserName As String
Dim MailDbName As String
’
Set Notes = CreateObject("Notes.NotesSession")
UserName = Notes.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Notes.GetDataBase(vbNullString, MailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo")
Set UIdoc = WorkSpace.CurrentDocument
’
’ 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 B130 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 Sheet1 to your sheet’s name
’
Recipient = Sheets("Alert Setup").Range("B125").Value
Call UIdoc.FieldSetText("EnterSendTo", Recipient)
’
’ Copy the email address from cell B146 into the CC: field in Lotus Notes
’ Note: Addresses in this cell should be separated by a semicolon
’
ccRecipient = Sheets("Alert Setup").Range("B126").Value
Call UIdoc.FieldSetText("EnterCopyTo", ccRecipient)
’
’ Copy the email address from cell B129 into the BCC: field in Lotus Notes
’ Note: Addresses in this cell should be separated by a semicolon
’
bccRecipient = Sheets("Alert Setup").Range("B127").Value
Call UIdoc.FieldSetText("EnterBlindCopyTo", bccRecipient)
’
’ Copy the subject from cell C4 into the SUBJECT: field in Lotus Notes
’
Subject1 = Sheets("Alert Setup").Range("C28").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 C33 to one cell below the range you wish to copy.
’
Call UIdoc.GotoField("Body")
Body1 = Replace(Join(Application.Transpose(Range([C28], [C36].End(3))), "@") & " ", "@", vbCrLf)
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 Maildb = Nothing: Set Notes = Nothing
Set Body = Nothing
End Sub
Try #2
Sub zzzXL2Notes()
’
Dim Notes As Object
Dim Maildb As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim NRTS As Object
Dim NRTI As Object
Dim strUserName As String
Dim strMailDbName As String
’
Set Notes = CreateObject("Notes.NotesSession")
strUserName = Notes.UserName
strMailDbName = Left$(strUserName, 1) & Right$(strUserName, (Len(strUserName) - InStr(1, strUserName, " "))) & ".nsf"
MsgBox strUserName & vbCrLf & strMailDbName
Set Maildb = Notes.GetDataBase(vbNullString, strMailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo")
Set UIdoc = WorkSpace.CurrentDocument
’
’ 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 B130 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 Sheet1 to your sheet’s name
’
Recipient = "Hutchinson.Jeff@gmail.com"
Call UIdoc.FieldSetText("EnterSendTo", Recipient)
’
’ Copy the subject from cell C4 into the SUBJECT: field in Lotus Notes
’
Subject1 = "testing testing"
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 C33 to one cell below the range you wish to copy.
’
Call UIdoc.GotoField("Body")
’ Call UIdoc.InsertText(“This text was inserted with " & “””" & “InsertText” & “”“” & vbCrLf)
’ Call UIdoc.AppendText(“This text was inserted with " & “””" & “AppendText” & “”“” & vbCrLf)
’ Body1 = Replace(Join(Application.Transpose(Range([C28], [C36].End(3))), “@”) & " ", “@”, vbCrLf)
’ Call UIdoc.InsertText(Body1)
’
Set NRTS = CreateObject("Notes.CreateRichTextStyle")
Set NRTI = CreateObject("Notes.CreateRichTextItem")
NRTS.FontSize = 12
NRTS.NotesColor = COLOR_BLUE
Call NRTI.AppendStyle(NRTS)
Call NRTI.AppendText("The meeting is at ")
NRTS.FontSize = 16
NRTS.NotesColor = COLOR_BLACK
Call NRTI.AppendStyle(NRTS)
Call NRTI.AppendText("3:00")
NRTS.FontSize = 12
NRTS.NotesColor = COLOR_BLUE
Call NRTI.AppendStyle(richStyle)
Call NRTI.AppendText(" not 2:00")
’
’ 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 Maildb = Nothing: Set Notes = Nothing
Set Body = Nothing
End Sub