Inserting picture in Lotus mail thru VBA

[johnjohns]

Hi All,

My very first question in this forum. I was trying to send mails thru Lotus Notes from Excel. It works fine but I cannot insert pictures to the body of mail. Following lines produce no result at all.

MyPic1.Copy
Set Data = New DataObject
Data.GetFromClipboard

I have posted the same question in www.excelforum.com also
http://www.excelforum.com/excel-programming/784527-inserting-picture-in-lotus-mail-thru-vba.html

Can somebody help? VBA codes I used are all picked from this forum and excelforum.com and I don't have much idea on what went wrong and where.

Sub SendMailDirect()
    Dim Session As Object
    Dim Maildb As Object
    Dim MailDoc, UIdoc, WorkSpace As Object
    Dim MyPic As Object
    Dim PeopleToAddress, SendToPeople, CCPeople, BccPeople As String
    Dim MailSubject, Subscription01, Subscription02, Subscription03, Subscription04, BodyOfText As String
    Dim TheAttachment As String
    Dim EmbedObj1 As Object
    Dim attachME As Object
    Dim DraftOrSend As String
    Dim OneCell As Range
    Dim SingleAttachment As Variant
 
    Dim MyPic1, Data As Object
    Set MyPic1 = ActiveSheet.DrawingObjects
 
    For Each OneCell In Selection.Cells
        PeopleToAddress = OneCell.Offset(0, 4).Value
        SendToPeople = OneCell.Offset(0, 1).Value
        CCPeople = OneCell.Offset(0, 2).Value
        BccPeople = OneCell.Offset(0, 3).Value
        BodyOfText = OneCell.Offset(0, 6).Value
        TheAttachment = OneCell.Offset(0, 0).Value
        DraftOrSend = OneCell.Offset(0, 7).Value
        MailSubject = OneCell.Offset(0, 5).Value
        Subscription01 = ActiveSheet.Range("Subscription01").Value
        Subscription02 = ActiveSheet.Range("Subscription02").Value
        Subscription03 = ActiveSheet.Range("Subscription03").Value
        Subscription04 = ActiveSheet.Range("Subscription04").Value
        TheContent = "Dear " & PeopleToAddress & "," & vbNewLine _
          & vbNewLine & vbNewLine _
          & BodyOfText _
          & vbNewLine _
          & vbNewLine & "With Regards," & vbNewLine _
          & vbNewLine & Subscription01 & vbNewLine _
          & Subscription02 & vbNewLine _
          & Subscription03 & vbNewLine _
          & Subscription04 & vbNewLine
        Set Session = CreateObject("Notes.NotesSession")
        Set Maildb = Session.GETDATABASE("", "")
        If Maildb.IsOpen <> True Then
           Maildb.OPENMAIL
        End If
        Set MailDoc = Maildb.CREATEDOCUMENT
        MailDoc.Form = "memo"
 
        MyPic1.Copy
        Set Data = New DataObject
        Data.GetFromClipboard
 
        With MailDoc
          .sendto = SendToPeople
          .Subject = MailSubject
          .Body = TheContent
          .Copyto = CCPeople
          .BlindCopyTo = BccPeople
        End With
        If TheAttachment <> "" Then
           Set attachME = MailDoc.CreateRichTextItem("TheAttachment")
           If InStr(1, TheAttachment, ",") > 0 Then
              For Each SingleAttachment In Split(TheAttachment, ",")
                 Set EmbedObj1 = attachME.EmbedObject(1454, "", Trim(SingleAttachment), "Attachment")
              Next SingleAttachment
           Else
              Set EmbedObj1 = attachME.EmbedObject(1454, "", TheAttachment, "Attachment")
           End If
           MailDoc.CreateRichTextItem ("Attachment")
        End If
        MailDoc.SAVEMESSAGEONSEND = True
        If DraftOrSend <> "Send" Then
           Call MailDoc.Save(True, False)
           MailDoc.RemoveItem ("DeliveredDate")
           Call MailDoc.Save(True, False)
        Else
           MailDoc.PostedDate = Now()
           MailDoc.Send 0, recipient
        End If
        Set objNotesField = Nothing
        Set Session = Nothing
        Set Maildb = Nothing
        Set MailDoc = Nothing
'       Optional code to check if email has been sent
'       MsgBox "Email Successfully sent to " & PeopleToAddress & Email
    Next OneCell
End Sub

 

[johnjohns]

Thanks a lot for the prompt replies, John. Please let me come back to you in another 2-3 days time. Today is weekend here and I have Lotus Notes in office only. Once again, Thank you.

regards

johnjohns

 

[gurtej176]

We got a consultant here to set up a macro that will send all the sheets(after converting the formulans to values) in the workbook to different email address in the worksheet as per the control sheet.

He basically said that its not possible with notes to attach a screen shot from excel and send the email automatically. What he can do it get the screen shot and create a new memo and then the user has to click on send. He tried his best but was not able to do it.

So I guess its pretty dificult.

 

[johnjohns]

Thanks for the feedback. But John W has already given a solution for the same. I will try it and come back with my feedback. Also if you search this forum there are solutions given by Nate Oliver also. This forum is having a lot of experts including MVP's. So we can take their word as final.

rgds

johnjohns

 

[johnjohns]

Dear John

Sorry that I could not come back to you fast. I am still getting the error in the following line when the procedure is called for the second time.

workspace.ComposeDocument , , "Memo"

And the error is
Runtime Error-7412
Notes Error-Specified command is not available from the workspace

Following is the version details of Lotus Notes I am using

IBM Lotus Notes 8.5​

Release 8.5.1

Revision 20090929.1223 (Release 8.5.1 FP1) ​

Standard Configuration

Thank you John for all the help you provided. If I can get rid of this glitch also then my problem is totally solved

with warm regards
johnjohns

 

[John_w]

Sorry, I don't know. It works for me on Notes 6.5, looping 10 times as shown in the code.

 

[johnjohns]

Thank you for the reply John and helping me so far. Since this is the only step balance as a hurdle, I am putting this request again. Can somebody help me to solve this issue?

rgds

johnjohns

 

[John_w]

Immediately after the Set db = Notes.GetDatabase line, try putting:

db.OpenMail

If the error occurs when the procedure is called for the second time it means that your Notes UI environment is not exactly the same as it was when called the first time (successfully). Is that the case? Are there any Notes dialogue windows open after the procedure is called the first time?

 

[klukiyan]

Doesn't work with shared mailbox

Dear John,
All the codes you provided work brilliant but only withing user's mailbox.
I have tried to modify it by changing this line:

Set db = Notes.GETDATABASE("", MailDbName)

to:

Set db = Notes.GETDATABASE("EMEA-AP05/SRV/CSC", "Mailin\GAservices.nsf")

This way it starts working with a group mailbox.
However there is a problem
After sending the email the Lotus Notes message window doesn't close, but pops up a window which ruins the whole macro:

Please help, I've tried everything, but nothing helps
How to avoid popping up? or how to close this window?

Thanks in advance

 

[klukiyan]

WOooow
I've found the solutions.
I've googled for "IBM Lotus Notes +"Do you want to save this new document?" how to prevent this window VBA"
And got the following row which need to be added right before

.close

This:

.Document.SaveOptions = "0"

In case somebody needs it, here it goes
Thank you anyway

 

[klukiyan]

Now I have another problem
How to make the message to appear in SENT folder of the mailbox?

Thank you