Embed Image in Lotus Notes Email

soccerkingpilot

Board Regular
Joined
May 21, 2012
Messages
105
I'm trying to embed an image file into the body of a Lotus Notes email. I have all of the code done except this piece. I've seen the previous forum threads regarding this, however, that approach doesn't seem to work with my code. Below is my code broken into the Notes session creation and the Email creation:

Notes Session Create:
Code:
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ShowWindow& Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)

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

Private Function CreateNotesSession&()
Const notesclass$ = "Notes"
' "Neues Memo - Lotus Notes"
Const SW_SHOWMAXIMIZED = 3
Dim Lotus_Session As Object

Dim rc&
Dim lotusWindow&

Set Lotus_Session = CreateObject("Notes.NotesSession")

DoEvents
DoEvents
lotusWindow = FindWindow("Notes", vbNullString)
If lotusWindow <> 0 Then
    rc = ShowWindow(lotusWindow, SW_SHOWMAXIMIZED)
    rc = SetForegroundWindow(lotusWindow)
    CreateNotesSession& = True
Else
    CreateNotesSession& = False
End If
End Function

Sub CreateMailandAttachFileAdr(Optional IsSubject As String = "", Optional SendToAdr As Variant, _
Optional CCToAdr As Variant, Optional BCCToAdr As String = "", Optional eAttach As Variant, _
Optional BodyText As String)
Const EMBED_ATTACHMENT As Integer = 1454
Const EMBED_OBJECT As Integer = 1453
Const EMBED_OBJECTLINK As Integer = 1452

Dim s As Object ' use back end classes to obtain mail database name
Dim db As Object '
Dim doc As Object ' front end document
Dim beDoc As Object ' back end document
Dim workspace As Object ' use front end classes to display to user
Dim bodypart As Object '


' checking if on citrix server or not
' if yes then asking the user to open lotus notes first
On Error GoTo err
Dim Lotus_Session As Object
Set Lotus_Session = CreateObject("Notes.NotesSession")
GoTo start

err:
Dim Path As String
Dim checkFile As String
Path = Environ("systemroot") & "\system32\srvmgr.exe"
'getting name of file
checkFile = Dir(Path)
If Len(checkFile) > 0 Then
MsgBox "Please Open Lotus Notes in WTS Desktop"
Exit Sub
Else
GoTo start
End If

start:
Call CreateNotesSession&

Set s = CreateObject("Notes.NotesSession") 'create notes session

Set db = s.GetDatabase("", "") 'set db to database not yet named
Call db.OPENMAIL ' set database to default mail database
Set beDoc = db.CreateDocument
Set bodypart = beDoc.CreateRichTextItem("Body")

' Filling the fields
'###################
beDoc.Subject = IsSubject
beDoc.SendTo = SendToAdr
beDoc.copyTo = CCToAdr
beDoc.BlindCopyTo = BCCToAdr
beDoc.Signature = ""
beDoc.body = BodyText
'''''''''''''''''''''''''
''If you want to send a message to more than one person or copy or
''blind carbon copy the following may be of use to you.

'beDoc.sendto = Recipient
'beDoc.CopyTo = ccRecipient
'beDoc.BlindCopyTo = bccRecipient

''Also for multiple email addresses you just set beDoc.sendto (or CopyTo or
''BlindCopyTo) to an array of variants each of which will receive the message. So

'Dim recip(25) As Variant
'recip(0) = "emailaddress1"
'recip(1) = "emailaddress2"

'beDoc.sendto = recip
''''''''''''''''''''''''

' beDoc.Body = "Hello Mary Lou, Goodbye heart"

Set workspace = CreateObject("Notes.NotesUIWorkspace")

' Positioning Cursor
'###################


 Call workspace.EDITDOCUMENT(True, beDoc).GOTOFIELD("Body")
'Call workspace.EditDocument(True, beDoc).GotoField("Subject")

Set s = Nothing

End Sub

Email Creation:
Code:
Sub LaunchMail()

'THIS LAUNCH THE EMAILING SYSTEM
  Dim emailTo(5) As Variant
  Dim emailCC(5) As Variant
  Dim emailAttach As Variant
  Dim emailSubject As String
  Dim emailBody As String
  Dim Recipient As String
  Dim i As Integer
'  Dim rs As ADODB.Recordset
'SEQUENCE TO ISSUE TEAMREQUEST REPORT
''Gather mandatory created for the specific Sales Order
'  Me.Requery
'   i = 0
'   Set rs = New ADODB.Recordset
'   rs.Open "Select Email from teamone where SONumber='" & SONumber & "' and POLayer='" _
'   & Forms!EditSalesOrder!PO & "'", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'   Do While Not rs.EOF
'     If IsNull(rs!Email) Then
'       rs.MoveNext
'      Else
'         emailTo(i) = rs!Email
'         i = i + 1
'        rs.MoveNext
'      End If
'     Loop
'     rs.Close
  
  'Generate bodies to fill lotus note fields

'In this space I'll bring in my variables from Excel. The image file (.png) needs to be embedded in the body with other text.

     img = "image here"
    
    emailTo(1) = "me@me.com"
    
    emailCC(1) = ""
      
    emailSubject = "Test Message"

    emailBody = "Hello World!"
      
    Call CreateMailandAttachFileAdr(emailSubject, emailTo, emailCC, , , emailBody)

End Sub

Hope I made this clear enough. It's kind of time sensitive so any help is greatly appreciated.

Thanks all,
Austin
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Forum statistics

Threads
1,211,454
Messages
6,101,944
Members
447,764
Latest member
gopalgriffith

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