J
J.W. Aldridge
I have spent SEVERAL days looking for a code that works and have not
been able to get it.
I need a macro that copies a certain cell range (named) as a bitmap or
picture, pastes it into the body of my email and sends it.
The names and subject is stationary, so I dont need it to ask each
time I send.
Can anyone point me in the direction of a proven code?
(Have tried over 15 - 20 already - all unsuccessful).
The following is the CLOSEST, but the range doesnt appear.
The range i want to copy is (B2:L22)
Please Help.
Sub LastTryAtLotusMail()
' setting up various objects
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim recipient As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim subject As String
Dim bodytext As String
Dim Attachment1 As String
Dim t1 As Range
Set t1 = Range("B2")
' setting up all sending recipients
recipient = "JEREMY ALDRIDGE"
ccRecipient = "JEREMY ALDRIDGE"
bccRecipient = "JEREMY ALDRIDGE"
subject = "Excel to Lotus Test Mail"
bodytext = "Testing this.."
'// Lets check to see if form is filled in Min req =Recipient,
Subject, Body Text
If recipient = vbNullString Or subject = vbNullString Or bodytext
= vbNullString Then
MsgBox "Recipient, Subject and or Body Text is NOT SET!",
vbCritical + vbInformation
Exit Sub
End If
' creating a notes session
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName)
- InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen <> True Then
On Error Resume Next
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
' loading the lotus notes e-mail with the inputed data
With MailDoc
.SendTo = recipient
.copyto = ccRecipient
.blindcopyto = bccRecipient
.subject = subject
.Body = bodytext + t1
End With
' saving message
MailDoc.SaveMessageOnSend = True
Attachment1 = Worksheets("Sheet 1").Range("B2:L22").Value
If Attachment1 <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "", Attachment1,
"Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If
' send e-mail !!!!
MailDoc.PostedDate = Now()
' if error in attachment or name of recipients
On Error GoTo errorhandler1
MailDoc.Send 0, recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
'Unload Me
Exit Sub
' setting up the error message
errorhandler1:
MsgBox "Incorrect name supplied or the attachment has not
attached," & _
"or your Lotus Notes has not opened correctly. Recommend you open
up Lotus Notes" & _
"to ensure the application runs correctly and that a vaild
connection exists"
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
' unloading the userform
'Unload Me
End Sub
been able to get it.
I need a macro that copies a certain cell range (named) as a bitmap or
picture, pastes it into the body of my email and sends it.
The names and subject is stationary, so I dont need it to ask each
time I send.
Can anyone point me in the direction of a proven code?
(Have tried over 15 - 20 already - all unsuccessful).
The following is the CLOSEST, but the range doesnt appear.
The range i want to copy is (B2:L22)
Please Help.
Sub LastTryAtLotusMail()
' setting up various objects
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim recipient As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim subject As String
Dim bodytext As String
Dim Attachment1 As String
Dim t1 As Range
Set t1 = Range("B2")
' setting up all sending recipients
recipient = "JEREMY ALDRIDGE"
ccRecipient = "JEREMY ALDRIDGE"
bccRecipient = "JEREMY ALDRIDGE"
subject = "Excel to Lotus Test Mail"
bodytext = "Testing this.."
'// Lets check to see if form is filled in Min req =Recipient,
Subject, Body Text
If recipient = vbNullString Or subject = vbNullString Or bodytext
= vbNullString Then
MsgBox "Recipient, Subject and or Body Text is NOT SET!",
vbCritical + vbInformation
Exit Sub
End If
' creating a notes session
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName)
- InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen <> True Then
On Error Resume Next
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
' loading the lotus notes e-mail with the inputed data
With MailDoc
.SendTo = recipient
.copyto = ccRecipient
.blindcopyto = bccRecipient
.subject = subject
.Body = bodytext + t1
End With
' saving message
MailDoc.SaveMessageOnSend = True
Attachment1 = Worksheets("Sheet 1").Range("B2:L22").Value
If Attachment1 <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "", Attachment1,
"Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If
' send e-mail !!!!
MailDoc.PostedDate = Now()
' if error in attachment or name of recipients
On Error GoTo errorhandler1
MailDoc.Send 0, recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
'Unload Me
Exit Sub
' setting up the error message
errorhandler1:
MsgBox "Incorrect name supplied or the attachment has not
attached," & _
"or your Lotus Notes has not opened correctly. Recommend you open
up Lotus Notes" & _
"to ensure the application runs correctly and that a vaild
connection exists"
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
' unloading the userform
'Unload Me
End Sub