# Sending mail via Lotus Notes and displaying a different address



## ericlbt (Mar 29, 2019)

Hello,

I use a macro to send emails with an attached picture via Lotus Notes.
The macro is working well but I need to change it so the mail appears to have been sent from a different address than mine.

In a different macro I was able to achieve that by adding the following lines.
They persuade Notes to send/display alternate address
MailDoc.From = "Projet"
MailDoc.SendFrom = "Projet"
MailDoc.DisplayFrom = "Projet"
MailDoc.Principal = "Projet"

I tried to copy those lines after changing "MailDoc" to "UIDoc" but it does't work.

What should I do to update my code to make it work?
Ideally, I would like to be able to send pictures and attach files using the same code.
But the most important is definitively to display a different address. 

THANK YOU FOR YOUR HELP.

Here is the code that needs to be modified:

Sub Mail_recap() 

Dim MyPic1 As Object 
Range("A65000").End(xlUp).Select 
Range(Selection, "L1").Select 
Set MyPic1 = Selection.SpecialCells(xlCellTypeVisible) 

Dim Notes As Object, db As Object, WorkSpace As Object 
Dim UIdoc As Object, UserName As String, MailDbName As String 
Dim document As Object 

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 db = Notes.GETDATABASE("", "f45.nsf") 

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

Set UIdoc = WorkSpace.currentdocument 
'Call UIdoc.FieldSetText("SendTo", "elb@test.ch") 'Recipient 
Call UIdoc.FieldSetText("EnterSendTo", "elb@test.ch") 'Recipient 

Call UIdoc.FieldSetText("Subject", "Recap") 

Call UIdoc.GOTOFIELD("Body") 
Call UIdoc.INSERTTEXT(WorksheetFunction.Substitute("Hello,@@@", "@", vbCrLf)) 

MyPic1.Copy: Call UIdoc.Paste 

Call UIdoc.INSERTTEXT(String(2, vbCrLf)) 

Call UIdoc.INSERTTEXT(Application.Substitute("@@@Regards.", "@", vbCrLf)) 
Application.CutCopyMode = False 

'Set document = Maildb.CREATEDOCUMENT 

Call UIdoc.Save(True, True) 
Call UIdoc.Send(False) 

Set docc = UIdoc.document 
With docc 
.SaveOptions = "0" 
End With 

Call UIdoc.Close(True) 

Set UIdoc = Nothing 
Set WorkSpace = Nothing 
Set db = Nothing 
Set Notes = Nothing 

End Sub


----------



## John_w (Mar 30, 2019)

This macro sends the email with a different sender name and email address.  Change the code where indicated.

```
Public Sub Mail_Recap2()

    Dim Session As Object, MailDb As Object, UIWorkspace As Object
    Dim UIdoc As Object, MailDoc As Object
    Dim UserName As String, MailDbName As String
    Dim rangePic As Range
    
    With ActiveSheet
        Set rangePic = .Range(.Cells(.Rows.Count, "A").End(xlUp), .Range("L1")).SpecialCells(xlCellTypeVisible)
    End With
    
    Set Session = CreateObject("Notes.NotesSession")
    Set UIWorkspace = CreateObject("Notes.NotesUIWorkspace")
            
    UserName = Session.UserName
    MailDbName = Left(UserName, 1) & Right(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set MailDb = Session.GetDatabase("", MailDbName)
    If Not MailDb.IsOpen Then MailDb.OpenMail
    
    UIWorkspace.ComposeDocument , , "Memo"
    Do
        Set UIdoc = UIWorkspace.CurrentDocument
        DoEvents
    Loop While UIdoc Is Nothing
    
    With UIdoc
        .FieldSetText "EnterSendTo", "email.address1@email.com"  'CHANGE THIS
        .FieldSetText "EnterCopyTo", "email.address2@email.com"  'CHANGE THIS
        .FieldSetText "Subject", "Recap"
    
        .GoToField "Body"
    
        .InsertText "Hello,"
        .InsertText vbCrLf
        .InsertText vbCrLf
        .InsertText vbCrLf
    
        rangePic.Copy
        .Paste
        Application.CutCopyMode = False
    
        .InsertText vbCrLf
        .InsertText vbCrLf
        .InsertText "Regards."
    
        .Save True, True
        .Send False
    
        Set MailDoc = .document
    End With
    
    With MailDoc
        .SaveOptions = "0"
    
        'Send with an alternative name and email address
        
        .ReplaceItemValue "From", "Another Name <another.address@email.com@NotesDomain>"  'CHANGE THIS
        .ReplaceItemValue "SendFrom", "Another Name <another.address@email.com@NotesDomain>"  'CHANGE THIS
        .ReplaceItemValue "Principal", "Another Name <another.address@email.com@NotesDomain>"  'CHANGE THIS

        'Send the email and save it in the Sent folder

        .SaveMessageOnSend = True
        .ReplaceItemValue "PostedDate", Now
        .Send False
    End With
    
    UIdoc.Close True
    
    Set UIdoc = Nothing
    Set UIWorkspace = Nothing
    Set MailDb = Nothing
    Set Session = Nothing

End Sub
```
Note - in the example email address, another.address@email.com@NotesDomain, the @NotesDomain part is required, but I think it can be anything (e.g. @Anything); it might even need to be your actual Notes domain.


----------



## ericlbt (Apr 1, 2019)

Hi John,

Thank you very much for your code.

For some reason, your code is working too well!

It actually generates 2 mails.
One from my address and one from the "another.address@email.com".

In both cases the content is fine.

I tried to change parts of the code but I didn't succeed to stop the mail sent from my address.

Do you have any suggestions?

Thank you again for your help.


----------



## ericlbt (Apr 2, 2019)

Hi John,

I have actually been able to find a solution.

I move the MailDoc part of your code higher up.
It does the trick.

I could not have done it without your code.

Thank you.


Public Sub Mail_Recap2() 

Dim Session As Object, MailDb As Object, UIWorkspace As Object 
Dim UIdoc As Object, MailDoc As Object 
Dim UserName As String, MailDbName As String 
Dim rangePic As Range 
Dim EmbedObj As Object 

With ActiveSheet 
Set rangePic = .Range(.Cells(.Rows.Count, "A").End(xlUp), .Range("L1")).SpecialCells(xlCellTypeVisible) 
End With 

Set Session = CreateObject("Notes.NotesSession") 
Set UIWorkspace = CreateObject("Notes.NotesUIWorkspace") 

UserName = Session.UserName 
MailDbName = Left(UserName, 1) & Right(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" 
Set MailDb = Session.GetDatabase("", MailDbName) 
If Not MailDb.IsOpen Then MailDb.OpenMail 

UIWorkspace.ComposeDocument , , "Memo" 
Do 
Set UIdoc = UIWorkspace.CurrentDocument 
DoEvents 
Loop While UIdoc Is Nothing 

With UIdoc 

Set MailDoc = .document 
End With 

With MailDoc 
.saveoptions = "0" 

'Send with an alternative name and email address 

'.ReplaceItemValue "From", "ProjetReporting Bo-Bourse <projet@mail.com>" 
'.ReplaceItemValue "SendFrom", "ProjetReporting Bo-Bourse <projet@mail.com>" 
.ReplaceItemValue "Principal", "ProjetReporting Bo-Bourse <projet@mail.com>>" 

'Send the email and save it in the Sent folder 

.SAVEMESSAGEONSEND = True 
.ReplaceItemValue "PostedDate", Now 
'.Send False 

Set AttachMe = MailDoc.CREATERICHTEXTITEM("attachment1") 
Set EmbedObj = AttachMe.EMBEDOBJECT(1454, "attachment1", "\\wpad-p.bcv.ch\Documents_Partages\Devises\SERVICE RECO POS & PNL\ELB\PROJETS\Récap Back & Front - AUTO.xlsb", "") 

End With 


With UIdoc 


.FieldSetText "EnterSendTo", "eric@mail.com" 
.FieldSetText "Subject", "Recap" 

.GoToField "Body" 

.INSERTTEXT "Hello," 
.INSERTTEXT vbCrLf 
.INSERTTEXT vbCrLf 
.INSERTTEXT vbCrLf 

rangePic.Copy 
.Paste 
Application.CutCopyMode = False 

.INSERTTEXT (Application.Substitute("@@@Cordialement.", "@", vbCrLf)) 

.Save True, True 
.Send False 

'Send the email and save it in the Sent folder 

End With 

UIdoc.Close True 

Set UIdoc = Nothing 
Set UIWorkspace = Nothing 
Set MailDb = Nothing 
Set Session = Nothing 

End Sub


----------



## John_w (Apr 5, 2019)

Thanks for posting your solution.  This should be useful for other people.


----------

