none
Embed Image in Lotus Notes Email RRS feed

  • Question

  • I've posted this on MrExcel.com here:http://www.mrexcel.com/forum/showthread.php?t=639331

    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

    Tuesday, June 5, 2012 10:32 PM

All replies