Inserting Images into Lotus Notes Email

santeria · Feb 13, 2004

Finally I have the code all okay for Sending Reports, and other extra comments etc...

And now...
Is there code available for picking up images ( Screen snaps) and inserting into an email in Notes after the Body of the Message?

Either a reference to a link or some code would be greatly appreciated, cos I cannot find any info at this point in the archives ( Presuming I have searched using proper parameters ).

Ta

santeria · Mar 1, 2004

Okay this last change got the File to send.
If I could cancel out the Spell Checker for the Macro then that would be great.

There are a variety of things I need to add in, and using this new variant on the code, it seems a tad difficult.

One is the Subject line instance.
Previously I could add in the General Subject, then a Format date for each variation ( Today, today minus one day etc), but I don't know how to do this in this case, and all I have is :

Code:

Call UIdoc.FieldSetText("Subject", "CMS Daily Report for " & Format(Date, "dddddd"))

Such that if I try and add a extra bit after the format area, it does not seem to work.

And in the Comment area, all the text I need is from a txt document that inserts like the Picture file.

Thus far, I have :

Code:

Call UIdoc.GotoField("Body")
Call UIdoc.InsertText(WorksheetFunction.Substitute( _
    "M:\EXPORTS\03_MARCH\CMS\DAILY\COMMENT.TXT"))

But this fails in the Substitute area.

I tried a variant of :

Code:

Call UIdoc.Application.InsertText(Application.Substitute("M:\EXPORTS\03_MARCH\CMS\DAILY\COMMENT.TXT"))

Other than that, it seems maybe straightforward, but then again, confusing to some degree

And, also, I don't know how to add in the CC field.

Ta

Code:

NateO · Mar 1, 2004

santeria said:
Okay this last change got the File to send.
If I could cancel out the Spell Checker for the Macro then that would be great.

I have no clue about this....

This can't/won't coerce the file's contents to a string. Try sequential access, e.g.,

Sub txtFileToVar()
Dim FileNum As Long, Output As String
Const myFile$ = "c:\temp\test.txt"
FileNum = FreeFile
Open myFile For Input As #FileNum
Output = StrConv(InputB$(LOF(FileNum), FileNum), vbUnicode)
Close #FileNum
MsgBox Output
End Sub

Other than that, it seems maybe straightforward, but then again, confusing to some degree

It makes sense, you can't pass a file path and expect the contents of that file to be magically passed in the specific format of your thinking. This is going to be true with any kind of file.

And, also, I don't know how to add in the CC field.

Try the following:

call uidoc.FieldSetText("SendToCC", "Blah Blah Blah")

santeria · Mar 1, 2004

Thanks.

If I run the txt file to var sub, then will this insert the txt into the Macro ?
Or is there a line needed that will input the txt to the email ?

Looks like this will work, I'll have to write it in and then test the emails.

Sorry about the confusion.

And I do appreciate the help.

I appreciate the help immensely.

Ta

NateO · Mar 1, 2004

Once you have the variable, pass it! I.e.,

Call UIdoc.InsertText(Output)

santeria · Mar 1, 2004

Okay, so the Sub defines the text value, and I assume the Filenum will have to have a numerical value for it to be called from the mail sub ?

Sorry, I 'm not too clear on the sequence.

Ta

NateO · Mar 2, 2004

Well, one should probably learn to walk before they attempt to run a marathon eh.

In any case, try the following:

Sub test()
Dim MyPic1 As Object, MyPic2 As Object
Dim FileNum As Long, Output As String
Const myFile$ = "c:\temp\test.txt"

FileNum = FreeFile
Open myFile For Input As #FileNum
Output = StrConv(InputB$(LOF(FileNum), FileNum), vbUnicode)
Close #FileNum

Application.ScreenUpdating = False
Set MyPic1 = ActiveSheet.Pictures.Insert( _
 "C:\Temp\Nate St. Andrew's3.jpg")
Set MyPic2 = ActiveSheet.Pictures.Insert( _
 "C:\Temp\stephnate2.jpg")
Call SendMail(MyPic1, MyPic2, Output)

MyPic1.Delete: MyPic2.Delete
Set MyPic1 = Nothing: Set MyPic2 = Nothing

Application.ScreenUpdating = True
End Sub

Private Sub SendMail(ByRef MyPic1 As Object, _
 ByRef MyPic2 As Object, ByVal myStr As String)

Dim Notes As Object, db As Object, WorkSpace As Object
Dim UIdoc As Object, AttachMe As Object, EmbedObj As Object
Dim UserName As String, MailDbName As String

Set Notes = CreateObject("Notes.NotesSession")

UserName = Notes.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, _
 (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

Set db = Notes.GetDataBase(vbNullString, MailDbName)

Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo")

Set UIdoc = WorkSpace.CurrentDocument

 '**** With R5 use: EnterSendTo ******
Call UIdoc.FieldSetText("SendTo", "WhomEver")
 '************************************
Call UIdoc.FieldSetText("Subject", "Pic Time")

Call UIdoc.GotoField("Body")
Call UIdoc.InsertText(WorksheetFunction.Substitute( _
 "Hey Buddy,@@Check out the pics eh!@@", _
 "@", vbCrLf))

MyPic1.Copy: Call UIdoc.Paste

Call UIdoc.InsertText(WorksheetFunction.Rept(vbCrLf, 2))

MyPic2.Copy: Call UIdoc.Paste

Call UIdoc.InsertText(Application.Substitute( _
 "@@Here's Some Comments

@", "@", vbCrLf))

Call UIdoc.InsertText(myStr)

Call UIdoc.InsertText(Application.Substitute( _
 "@@Don't Be A Stranger,@Moi", "@", vbCrLf))
Application.CutCopyMode = False

Set AttachMe = UIdoc.document.CreateRichtextitem("Attachment")

Set EmbedObj = AttachMe.EmbedObject(1454, _
 vbNullString, "c:\temp\test.bat", "Attachment")

UIdoc.document.posteddate = Now
Call UIdoc.Send(False)
Call UIdoc.Close

Set EmbedObj = Nothing: Set AttachMe = Nothing
Set UIdoc = Nothing: Set WorkSpace = Nothing
Set db = Nothing: Set Notes = Nothing

End Sub

Regarding your spell checker, and possibly your ongoing LN Object Model/Lotus Script questions (e.g., spell checker), you may be in the wrong forum, they're really not Excel questions. Check out the following:

http://www-10.lotus.com/ldd/communities.nsf

It may be more relevant. Plus, these guys probably actually like this software.

santeria · Mar 2, 2004

Thanks

Very Much appreciated.

ray:

santeria · Mar 4, 2004

I still need some advice on this line:

Call UIdoc.FieldSetText("Subject", "Pic Time")

Can it be edited to have a text field, then a Variable ( Date Format) then a second comment field for the subject ?

Also, a CC field.... okay nevermind... just saw it in the previous comments

Mmmm, just ran it... the CC field fails. Just stops on the line

Call UIdoc.FieldSetText("EnterSendToCC", "Name/CCMG/CVG@CVG")

Ta

cdupontm · Oct 2, 2009

Hi,
This thread was awesome and helped me a lot.
Everything is working fine but I do have one question:
Somehow the text ( or the picture ) is past "only" on the third row of the email (therefore living three lines blank at the top of my email) it is no big drama but it is still annoying.
Any idea how can i get rid of those three lines ? When I manually copy past my graph in a lotus notes email it is past of the "first" line .... that is why i am quite confused ...
Tks a lot for any help.

Cyprien

Balvinder Rayat · Nov 22, 2011

Hi,

With reference to above posts, I've been able to create automated e-mail to send excel range in image format. But e-mails are not going & it is showing below error:

Do you wan to send, Save or discard your changes? Choose cancel to continue editing.

Further when i chose to send & save option then it shows below error:

"Message could not be send or saved, Please select information classification"

When i select send only option, mails are going & working fine.

I have google this error resolution all across web but didn't find any suitable solution. Please help me to resolve this error:

I know it has something to do with below code but not able to understand how to resolve.

Code:

With NotesDoc
        .postedDate = Date
        .Save True, False, True
        .SaveOptions = "0"
        .SEND False
   End With

Below is my entire working code till now:

Code:

Public Function SendEMail()

Dim thisWB  As String
Dim newWB As String
Dim Email As String
Dim SendTo As String
Dim EmailSubject As String
Dim MyAttachment As String


    thisWB = ActiveWorkbook.Name
    
    On Error Resume Next
    Sheets("tempsheet").Delete
    On Error GoTo 0
    
    Sheets.Add
    ActiveSheet.Name = "tempsheet"
    Sheets("Data").Select
    
    If ActiveSheet.AutoFilterMode Then
        Cells.Select
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End If
    
    Columns("A:A").Select
    Selection.Copy
    
    Sheets("tempsheet").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    
    If (Cells(1, 1) = "") Then
        lastrow = Cells(1, 1).End(xlDown).Row
        
        If lastrow <> Rows.Count Then
            Range("A1:A" & lastrow - 1).Select
            Selection.Delete Shift:=xlUp
        End If
    
    End If
    
    Columns("A:A").Select
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
    
    Columns("A:A").Delete
    
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    
    lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row
    
    For suppNo = 2 To lMaxSupp
    
        Windows(thisWB).Activate
        SupName = Sheets("tempsheet").Range("A" & suppNo)
        
        If SupName <> "" Then
            
            Sheets("Data").Select
            Cells.Select
            
            ActiveSheet.Range("$A$1:$E$65000").AutoFilter Field:=1, Criteria1:="=" & SupName
            
            Columns("A:E").Select
            Range(Selection, Selection.End(xlUp)).Select
            Selection.Copy
            Sheets("Sheet5").Select
            Range("A1").Select
            ActiveSheet.Paste
            Cells.Select
            Cells.EntireColumn.AutoFit
            
            'Storing e-mail id into Email variable where email need to be sent
            Email = Range("E2").Value
            
            Range("A2:D2").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Range").Select
            Range("B23").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("A1").Select
        End If
            
  
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
   
   '********************************************************************************************
   
SendEMail = True

Dim myRange As Range

'Set E-mail format range
    Worksheets("Range").Activate
    Worksheets("Range").Range("A1:F44").Select
    Worksheets("Range").Range("A1:F44").Copy

On Error GoTo ErrorMsg
   
    Dim EmailList As Variant
    Dim ws, uidoc, session, db, uidb, NotesAttach, NotesDoc, objShell As Object
    Dim RichTextBody, RichTextAttachment As Object
    Dim server, mailfile, user, usersig As String
    Dim SubjectTxt, MsgTxt As String
           
    Set session = CreateObject("Notes.NotesSession")
    If session Is Nothing Then
        MsgBox "Sorry, unable to instantiate the Notes Session", vbOKOnly, "Unable to Continue"
        SendEMail = False
    End If
   
    user = session.UserName
    usersig = session.CommonUserName
    server = ""
    'server = session.GetEnvironmentString("MailServer", True)
    mailfile = session.GetEnvironmentString("MailFile", True)
   
    Set db = session.GetDatabase(server, mailfile)
    If Not db.IsOpen Then
        Call db.Open("", "")
        Exit Function
    End If
           
    If Not db.IsOpen Then
        MsgBox "Sorry, unable to open: " & mailfile, vbOK, "Unable to Continue"
        SendEMail = False
    End If
    
    Set NotesDoc = db.createdocument
    
    With NotesDoc
        .form = "Memo"
        .Subject = "ECS Transaction Pre-Hit Intimation" 'The subject line in the email
        .Principal = user
        .SendTo = Email  'e-mail ID variable to identify whom email need to be sent
    End With
    
    Set RichTextBody = NotesDoc.CreateRichTextItem("Body")
   
    With NotesDoc
        .computewithform False, False
        .SAVEMESSAGEONSEND = True
        .Save True, False, True
        
    End With
        
   'Now set the front end stuff
   Set ws = CreateObject("Notes.NotesUIWorkspace")
   If Not ws Is Nothing Then
   Set uidoc = ws.editdocument(True, NotesDoc)
   
    If Not uidoc Is Nothing Then
         If uidoc.editmode Then
           Call uidoc.gotofield("Body")
           Call uidoc.Paste
           Call uidoc.Close
         End If
     End If
   End If
   
   With NotesDoc
        .postedDate = Date
        .Save True, False, True
        .SaveOptions = "0"
        .SEND False
   End With
   
   'close connection to free memory
    Set session = Nothing
    Set db = Nothing
    Set NotesAttach = Nothing
    Set NotesDoc = Nothing
    Set uidoc = Nothing
    Set ws = Nothing
    
ErrorMsg:
    SendEMail = False
    If Err.Number = 7225 Then
            MsgBox "The file " & Range("Fname_NZ_VaR") & " cannot be found in the location " & _
            Range("Path_NZ_VaR"), vbOKOnly, "Error"
    ElseIf Err.Number = 1004 Then
            MsgBox "One of the following may be causing an error:" & vbCrLf & _
            "1. The range 'Path_NZ_VaR' and/or 'Fname_NZ_VaR' does not exist in this spreadsheet," & _
            vbCrLf & "2. The range 'Fname_NZ_VaR' does not contain a filename," & vbCrLf _
            & "3. The path " & Range("Path_NZ_VaR") & " does not exist.", vbOKOnly, "Error"
    Else
            MsgBox Err.Number & Err.Description
    End If

Exit Function
   
Next
            Sheets("tempsheet").Delete
            Sheets("Total Data").Select
    
            If ActiveSheet.AutoFilterMode Then
                Cells.Select
                ActiveSheet.ShowAllData
            End If
End Function

Inserting Images into Lotus Notes Email

santeria

Well-known Member

santeria

Well-known Member

Excel Facts

NateO

Legend

santeria

Well-known Member

NateO

Legend

santeria

Well-known Member

NateO

Legend

santeria

Well-known Member

santeria

Well-known Member

cdupontm

New Member

Balvinder Rayat

New Member

Similar threads

Forum statistics

Share this page

Inserting Images into Lotus Notes Email

Well-known Member

Well-known Member

Excel Facts

Legend

Well-known Member

Legend

Well-known Member

Legend

Well-known Member

Well-known Member

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock