Excel to lotus notes vba - Word и Excel - помощь в работе с программами

I have little Lotus Script or Notes/Domino knowledge but I have a procedure, copied from somewhere a long time ago, that allows me to email through Notes from VBA. I normally only use this for internal notifications where the formatting hasn’t really mattered.

I now want to use this to send external emails to a client, and corporate types would rather the email complied with our style guide (a sans-serif typeface basically).

I was about to tell them that the code only works with plain text, but then I noticed that the routine does reference some sort of CREATERICHTEXTITEM object. Does this mean I could apply some sort of formatting to the body text string after it has been passed to the mail routine? As well as upholding our precious brand values, this would be quite handy to me for highlighting certain passages in the email.

I’ve had a dig about the ‘net to see if this code could be adapted, but being unfamiliar with Notes’ object model, and the fact that online Notes resources seem to mirror the application’s own obtuseness, meant I didn’t get very far.

The code:

Sub sendEmail(EmailSubject As String, EMailSendTo As String, EMailBody As String, MailServer as String)

    Dim objNotesSession As Object
    Dim objNotesMailFile As Object
    Dim objNotesDocument As Object
    Dim objNotesField As Object
    Dim sendmail As Boolean

    'added for integration into reporting tool
    Dim dbString As String

    dbString = "mail" & Application.UserName & ".nsf"

On Error GoTo SendMailError
    'Establish Connection to Notes
    Set objNotesSession = CreateObject("Notes.NotesSession")
On Error Resume Next
    'Establish Connection to Mail File
    Set objNotesMailFile = objNotesSession.GETDATABASE(MailServer, dbString)
    'Open Mail
    objNotesMailFile.OPENMAIL
On Error GoTo 0

    'Create New Memo
    Set objNotesDocument = objNotesMailFile.createdocument

    Dim oWorkSpace As Object, oUIdoc As Object
    Set oWorkSpace = CreateObject("Notes.NotesUIWorkspace")
    Set oUIdoc = oWorkSpace.CurrentDocument

    'Create 'Subject Field'
    Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)

    'Create 'Send To' Field
    Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)

    'Create 'Copy To' Field
    Set objNotesField = objNotesDocument.APPENDITEMVALUE("CopyTo", EMailCCTo)

    'Create 'Blind Copy To' Field
    Set objNotesField = objNotesDocument.APPENDITEMVALUE("BlindCopyTo", EMailBCCTo)

    'Create 'Body' of memo
    Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")

    With objNotesField
        .APPENDTEXT emailBody
        .ADDNEWLINE 1
    End With

    'Send the e-mail

    Call objNotesDocument.Save(True, False, False)
    objNotesDocument.SaveMessageOnSend = True
    'objNotesDocument.Save
    objNotesDocument.Send (0)

    'Release storage
    Set objNotesSession = Nothing
    Set objNotesMailFile = Nothing
    Set objNotesDocument = Nothing
    Set objNotesField = Nothing

    'Set return code
    sendmail = True

    Exit Sub

SendMailError:
    Dim Msg
    Msg = "Error # " & Str(Err.Number) & " was generated by " _
                & Err.Source & Chr(13) & Err.Description
    MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
    sendmail = False
End Sub

Источник

Всеволод С

Пользователь

Сообщений: 52
Регистрация: 01.07.2013

Добрый день!

На главной есть статья, разбирающая отправку

Excel to Outlook

с помощью VBA, при ниже есть битая ссылка

Макросы для отправки почты из Excel через Lotus Notes от Dennis Wallentin

Я нашел код, но к сожалению, в силу отсутствия каких-либо навыков VBA программирования не могу адаптировать его под себя:

Скрытый текст

Большая просьба помочь с рядом вопросов:

Код
Const stSubject As String = "Weekly report":

Если тема письма варьируется от недели к неделе, допустим, сейчас это будет Week Results 23, на след недел Week Results 24, какие есть варианты решения?
Я вижу это как: а) всплывающие окно, в котором я указываю номер недели или б) лучше в коде самостоятельно определяется текущая неделя

Код
Const stPath As String = "c:Attachments"

Этой срочкой автор указывает путь, где лежит документ с которым он работает?

Код
Sub Send_Active_Sheet()

В примере рассмотрен случай вложения текущего листа в письмо.
Как будет выглядет код, если у меня есть фиксированная директория (например, Недельные отчёты2015Week 24), в которой уже лежат подготовленные отчеты
и мне надо вложить все excel файлы из этой папки в письмо?
Дополнительно стоит указать, что номер папки варьируется (равно как и тема письма) поэтому, по идеи это можно связать. Т.е. в коде определяется номер недели и используется как в stSubject так и в месте, откуда забираются файлы
4.

Код
vaRecipients = VBA.Array("name1@mail.com", "name1@mail.com")

Если у меня постоянный список получателей, я могу вынести их в верхний блок? Как будет выглядеть код?

Код
Const vaRecipients = VBA.Array("name1@mail.com", "name1@mail.com")

Код
Set noSession = CreateObject("Notes.NotesSession") Set noDatabase = noSession.GETDATABASE("", "")

Во второй строчке нужно указать путь к базе лотус?

6. Как добавить просмотр документа перед отправкой?

Видел в примере на главной, что для outlook была использована команда display

Т.е. я меняю

На

Заранее спасибо, если вы ответите хоть на часть вопросов, либо подскажите направление, где копать

Источник

I have been trying to get a MS Excel spread sheet to email specific content of an Excel sheet to an email message. I have found the code that allows for me to generate an email message and that work swimmingly. Especially if I wanted to attach the Spread sheet (works great as well). What I would really like to do (that I have determined cannot be done because the NotesUI does not support COM) is esentially:

VBA for Excel -> Select Cells -> Paste into a Notes Document (maintaining the Cell Formatting).

The code that I have (see end of question) that works will only copy the text to the email document (I have removed all comments for the code, I originally got this code from the internet and modified it slightly to give credit to the owner whoever they may be).

I have given up on the Copy and Paste approach (which would have worked great) and have decided to try and use HTML formatting to get as close to the results that I would like. I am thinking some thing like:

Dim BodyText As String — > Then —> BodyText = «MY HTML Code» —> then dump that to the Body of the email message. Which does not work, the text is exactly as I send it, but the client does not execute the HTML — it displays it. I have been trying to figure out Lotus Notes PassThru HTML but cannot get it to work either.

Any suggestions or pointers will be greatly appreciated.

##### Begin Excel VBA Code to pass email to Notes #####

Private Sub CommandButton1_Click()
Dim Maildb As Object ‘The mail database
Dim UserName As String ‘The current users notes name
Dim MailDbName As String ‘The current users notes mail database name
Dim MailDoc As Object ‘The mail document itself
Dim AttachME As Object ‘The attachment richtextfile object
Dim Session As Object ‘The notes session
Dim EmbedObj As Object ‘The embedded object (Attachment)
Dim Subject As String ‘The subject string
Dim Attachment As String ‘The path to the attachemnt string
Dim Recipient As String ‘The Recipient string (or you could use the list)
Dim Recip(10) As Variant ‘The Recipient list
Dim BodyText As String ‘The body text
Dim SaveIt As Boolean ‘Save to sent mail
Dim WasOpen As Integer ‘Checking to see if the Mail DB was already
‘open to determine if session should be
‘closed (0) or left alone (1)
Dim ClipBoard As DataObject ‘Data object for getting text from clipboard
Subject = «This is a Test Email Messag»
Recipient = «Notes Email User»pying it to Clipboard
Sheets(«Sheet1»).Select
Range(«A5:G19»).Select
Selection.Copy
Set ClipBoard = New DataObject
ClipBoard.GetFromClipboard
SaveIt = True
Set Session = CreateObject(«Notes.NotesSession»)
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) — InStr(1, UserName, » «))) & «.nsf»
Set Maildb = Session.GETDATABASE(«», MailDbName)
If Maildb.ISOPEN = True Then
WasOpen = 1 ‘Already open for mail
Else
WasOpen = 0
Maildb.OPENMAIL ‘This will prompt you for password
End If
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = «Memo»
MailDoc.sendto = Recipient ‘Or use Racip(10) for multiple
MailDoc.Subject = Subject
MailDoc.body = ClipBoard.GetText(1)
MailDoc.SAVEMESSAGEONSEND = SaveIt
If Attachment <> «» Then
Set AttachME = MailDoc.CREATERICHTEXTITEM(«Attachment»)
Set EmbedObj = AttachME.EMBEDOBJECT(1454, «», Attachment, «Attachment»)
MailDoc.CREATERICHTEXTITEM («Attachment»)
End If
MailDoc.PostedDate = Now() ‘Gets the mail to appear in the sent items folder
MailDoc.SEND 0, Recipient
‘Clean Up’
Range(«A1»).Select
Application.CutCopyMode = False
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set EmbedObj = Nothing
If WasOpen = 1 Then
Set Session = Nothing
ElseIf WasOpen = 0 Then
Session.Close
Set Session = Nothing
End If

MsgBox «The Line Down Email was sent», vbOKOnly

End Sub

Thanks again in advance

Источник

So here’s the actual code. Instead of C1, C2,etc., it’s actually E17, E18, E19,etc. A1 is for blank spaces. I still need to paste the the screenshot in the middle of the mail and i need to to format the texts.

Sub Email_BAC()

Application.ScreenUpdating = False
Range(«a1»).Select

Set bsrecWb = ActiveWorkbook
Calculate

‘Created from several codes found on mrexcel.com
‘Modified Original code by Nate Oliver (thank you)
‘Thanks to help by mrexcel.com username «schielrn»
‘Thanks to help by mrexcel.com username «Norie»
‘Modified by Robert Balentine who knows not much about this stuff
‘Date created 02-27-08
‘This macro does the following:
‘ A. Confirmed working on Excel 2003
‘ B. Opens Lotus Notes 6.5 or 7
‘ C. Opens a new memo message
‘ D. Copies data from the excel spreadsheet, email addresses, subject, and body
‘ E. Pastes this data as TEXT into the email
‘ F. If a user has auto signature already configured in lotus notes, this is preserved (either html or text)

Dim Notes As Object
Dim db As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim UserName As String
Dim 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

‘If cells are null, such as email address, cc, etc, then ignore and dont paste into email
On Error Resume Next

‘Copy the email address from cell C19 into the TO: field in Lotus Notes
‘Note: Addresses in this cell should be separated by a semicolon.
‘Please change your current sheet’s name from Sheet1 to your sheet’s name

bsrecWb.Activate

Recipient = Sheets(«Email»).Range(«B16»).Value
Call UIdoc.FieldSetText(«EnterSendTo», Recipient)

‘Copy the email address from cellC C20 into the CC: field in Lotus Notes
‘Note: Addresses in this cell should be separated by a semicolon
ccRecipient = Sheets(«Email»).Range(«C16»).Value
Call UIdoc.FieldSetText(«EnterCopyTo», ccRecipient)

‘Copy the email address from cell C21 into the BCC: field in Lotus Notes
‘Note: Addresses in this cell should be separated by a semicolon
‘bccRecipient = Sheets(«Email»).Range(«A1»).Value
‘Call UIdoc.FieldSetText(«EnterBlindCopyTo», bccRecipient)

‘Copy the subject from cell C22 into the SUBJECT: field in Lotus Notes
Subject1 = Sheets(«Email»).Range(«D16»).Value
Call UIdoc.FieldSetText(«Subject», Subject1)

‘Copy the cells in the range (one column going down) into the BODY in Lotus Notes.
‘You must set the last cell C47 to one cell below the range you wish to copy.

‘screenshot
MyPic.Copy
‘screenshot

Call UIdoc.GotoField(«Body»)
body1 = Sheets(«Email»).Range(«E16»).Value
body1 = body1 & vbCrLf & Sheets(«Email»).Range(«A1»).Value ‘ Space
body1 = body1 & vbCrLf & Sheets(«Email»).Range(«E17»).Value
body1 = body1 & vbCrLf & Sheets(«Email»).Range(«A1»).Value ‘ Space
body1 = body1 & vbCrLf & Sheets(«Email»).Range(«E18»).Value
body1 = body1 & vbCrLf & Sheets(«Email»).Range(«A1»).Value ‘ Space
body1 = body1 & vbCrLf & Sheets(«Email»).Range(«A1»).Value ‘ Space

Call UIdoc.InsertText(body1)

‘Insert some carriage returns at the end of the email
Call UIdoc.InsertText(vbCrLf & vbCrLf)
Application.CutCopyMode = False

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

MsgBox «Congratulations! Email created»

End Sub

See if you can adapt this code to your specific requirements. It does everything you asked for, including different font styles and colours, an embedded image, file attachment and automatic signature, if defined in your Notes User preferences. You just need to edit the code in 2 sections where indicated to retrieve values from the relevant Excel cells. You shouldn’t need to change any other parts of the code.

In Tools — References in the VB editor, you must tick the reference to Lotus Domino Objects for this code to compile successfully.

Code:

Public Sub Send_Notes_Email()

'Requires reference to Lotus Domino Objects (domobj.tlb) for constants such as EMBED_ATTACHMENT and FONT_HELV, etc.
'Code based on answer by Bill-Hanson:
'http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/Lotus_SmartSuite/Lotus_Notes/Q_22733557.html#a19616928

    Dim NSession As Object
    Dim NUIWorkspace As Object
    Dim NMailDb As Object
    Dim NDocumentTemp As Object
    Dim NUIDocumentTemp As Object
    Dim NUIDocument As Object
    Dim NRTItemBody As Object
    Dim NRTStyle As Object, NRTStyleDefault As Object
    Dim NRTItemAttachment As Object, embeddedAttachment As Object
    Dim Subject As String
    Dim SendTo As String, CopyTo As String, BlindCopyTo As String
    Dim fileAttachment As String
    Dim embedCells As Range
    Dim FSO As Object
    Dim tempFolder As String, tempCellsJPG As String
    Dim Copy_and_Paste As Boolean
    
    '--------- EDIT USER-DEFINED SETTINGS IN THIS SECTION ---------
    
    'The Excel cells to be included in the email body as an image
    
    Set embedCells = ActiveSheet.Range("A1:C8")
        
    'The file to be attached to the email, if it exists
    
    fileAttachment = "C:folder1folder2file.txt"
    
    SendTo = "email1@email.com,email2@email.com"
    CopyTo = "email2@email.com"
    BlindCopyTo = ""
    Subject = "Email subject"
    
    '--------- END OF USER-DEFINED SETTINGS ---------
    
    'Copy_and_Paste flag
    'True = copy and paste Excel cells into email body using the clipboard
    'False = save Excel cells as a temporary .jpg file and import into email body
    
    Copy_and_Paste = True
        
    Set FSO = CreateObject("Scripting.FileSystemObject")
    tempFolder = FSO.GetSpecialFolder(2)
    
    'File name for temporary .jpg file containing Excel cells
   
    tempCellsJPG = tempFolder & "" & Replace(FSO.GetTempName(), ".tmp", ".jpg")
    
    Set NSession = CreateObject("Notes.NotesSession")   'OLE (late binding only) because we access Notes UI classes
    Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
    Set NMailDb = NSession.GetDatabase("", "")
    NMailDb.OpenMail
   
    'Create the default rich text style
    
    Set NRTStyleDefault = NSession.CreateRichTextStyle
    With NRTStyleDefault
        .NotesColor = COLOR_BLACK
        .FontSize = 10
        .NotesFont = FONT_HELV
        .Bold = False
        .Italic = False
    End With
    
    Set NRTStyle = NSession.CreateRichTextStyle
   
    'Create a temporary NotesDocument
    
    Set NDocumentTemp = NMailDb.CreateDocument
    With NDocumentTemp
        .Form = "Memo"
        
        'Add a rich text item to contain the email body text and file attachment
        
        Set NRTItemBody = .CreateRichTextItem("Body")
        With NRTItemBody
            
            '--------- ADD/EDIT CODE IN THIS SECTION FOR THE EMAIL BODY TEXT ---------
            
            'Compose the email body text
            
            .AppendText "1st paragraph - default font."
            .AddNewLine 2

            With NRTStyle
                .NotesFont = FONT_ROMAN
                .FontSize = 14
                .NotesColor = COLOR_BLUE
                .Bold = True
            End With
            .AppendStyle NRTStyle
            .AppendText "2nd paragraph - Times New Roman Blue 14 Bold"
            .AddNewLine 2
        
            'Add placeholder text which will be replaced by the Excel cells
        
            .AppendText "{PLACEHOLDER}"
            .AddNewLine 2
            
            With NRTStyle
                .NotesFont = FONT_HELV
                .FontSize = 10
                .NotesColor = COLOR_RED
                .Italic = True
            End With
            .AppendStyle NRTStyle
            .AppendText "3rd paragraph - Helvetica Red 10 italic."
            
            'Same paragraph, default style
            
            .AppendStyle NRTStyleDefault
            .AppendText "  Excel cells are shown above."
            
            If fileAttachment <> "" Then
                .AddNewLine 2
                .AppendText fileAttachment & " attached"
                .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                .AddNewLine 1
            End If
            
            '--------- END OF EMAIL BODY TEXT SECTION --------
            
        End With
        
        .Save False, False
    End With
   
    'Display the temporary document in the UI
    
    Set NUIDocumentTemp = NUIWorkspace.EditDocument(True, NDocumentTemp)
   
    'Copy the rich text to the clipboard, close the window, and delete the temp doc
    
    With NUIDocumentTemp
        .gotofield "Body"
        .SelectAll
        .Copy
        'The next 2 lines are not needed
        '.Document.SaveOptions = "0" 'prevent prompt
        '.Document.MailOptions = "0" 'prevent prompt
        .Close                      'therefore temp UI doc not saved
    End With
    NDocumentTemp.Remove True

    'Compose the real email document
    
    Set NUIDocument = NUIWorkspace.ComposeDocument(NMailDb.Server, NMailDb.filePath, "Memo")
    'Set NUIDocument = NUIWorkspace.ComposeDocument(, , "Memo")      'use local computer and current database
    With NUIDocument
        .FieldSetText "EnterSendTo", SendTo
        .FieldSetText "EnterCopyTo", CopyTo
        .FieldSetText "BlindCopyTo", BlindCopyTo
        .FieldSetText "Subject", Subject

        'The memo now has everything except the rich text from the temporary UI document and the Excel cells image.
        'The automatic signature (if defined in User Preferences) should be at the bottom of the memo.  Now, we just
        'paste the rich text and Excel cells into the body
        
        .gotofield "Body"
        .Paste
   
        'Replace the placeholder text with the Excel cells image
        
        .gotofield "Body"
        .FindString "{PLACEHOLDER}"
        '.DESELECTALL                   'Uncomment to leave the placeholder text in place (cells are inserted immediately before it)
        
        If Copy_and_Paste Then
            embedCells.CopyPicture xlBitmap
            .Paste
            Application.CutCopyMode = False
        Else
            Save_Object_As_JPG embedCells, tempCellsJPG
            .Import "JPEG Image", tempCellsJPG
            Kill tempCellsJPG
        End If

        'Set NotesDocument options to save and send the email without prompts when the Close method is called
        
        .Document.SaveOptions = "1"
        .Document.MailOptions = "1"
        
        .Close
    End With
    
End Sub


'Based on http://www.jpsoftwaretech.com/export-excel-range-to-a-picture-file/

Private Sub Save_Object_As_JPG(saveObject As Object, JPGfileName As String)

    'Save a picture of an object as a JPG/JPEG file
    
    'Arguments
    'saveObject     - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
    'JPGfileName    - the file name (including folder path if required) to save the picture as
    
    Dim temporaryChart As ChartObject
     
    Application.ScreenUpdating = False
    
    saveObject.CopyPicture xlScreen, xlPicture
    
    Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width, saveObject.Height)
    With temporaryChart
        .Border.LineStyle = xlLineStyleNone      'No border
        .Chart.Paste
        .Chart.Export JPGfileName
        .Delete
    End With
    
    Application.ScreenUpdating = True
    
    Set temporaryChart = Nothing
    
End Sub

The attached jpeg file seems to be stuck at the bottom of the mail. Is there a way to place it mid part of the mail?

is there a way that I can send an email from the stationery (tools)? my daily email includes a command button

Hi Excel Experts.

I need your help. I am trying to create an Excell file that will automatically send reference cell (exam score) to specific recepients, informing them of their score. I am really not an expert with codes so I was wondering if someone can teach this dummy here. hehe

So that say after exam scores are up, I will just enter their individual score in this sheet probably run a macro and it will send an email (using Lotus notes) to say 200 recepients notifying them of their scores.

This might be very easy to do. but please help. I am working on automating sending individual scores using excell. Thank you very much in advance and more power.

@ John_w

At «.GOTOFIELD «Body» » in this part

Code:

With NUIDocumentTemp        
        .GOTOFIELD "Body"
        .SelectAll
        .Copy
        .Close                     
    End With

Error msg:
«Object variable with block not set»
My code stops, since NUIDocumentTemp has not been Set/created?
It will finish(create another temp-mail) If I manually make the macro run

Code:

Set NUIDocumentTemp = NUIWorkspace.EDITDOCUMENT(True, NDocumentTemp)

again.

is there a way around this? And what is the cause? =(

Last edited: Aug 14, 2014

Arithos, it might be a timing issue with the Notes UI. Therefore try adding a wait before the EditDocument line:

Code:

    Application.Wait DateAdd("s", 2, Now)

The code works perfectly for me on Lotus Notes 6.5.5. I haven’t tried it on other versions.

Arithos, it might be a timing issue with the Notes UI. Therefore try adding a wait before the EditDocument line:
Code:
    Application.Wait DateAdd("s", 2, Now)
The code works perfectly for me on Lotus Notes 6.5.5. I haven’t tried it on other versions.

Thank you!

Since it’s my first time using VBA to access other applications in this way I’ll forgive myself for this obvius mistake (on my part).
I added your code two different places in my code. However, if I dont have just used Lotus Notes (In my case It has to be open on my other screen) I still get the same error in the same place, or when I try to run this line:

Code:

Set NUIDocument = NUIWorkspace.COMPOSEDOCUMENT(NMailDb.Server, NMailDb.FilePath, "Memo")

So I added the code:

Code:

Application.Wait DateAdd("s", 2, Now)

Above theese points of errors, and added some Errror handling to help my «users». Is there a way around this aswell? Add more wait time, have I added your code at the wrong places? (added it above the «Error-spots»)

ps: I can verify that your code works on Lotus 8.5.x aswell

This is my code in its entirety.

This is code from a Userform

I have marked the problem areas in RED so that its easy to identify, some of the code is redundant, and I know this.

Code:

Private Sub UserForm_Initialize()


Mottakerliste.Clear


With Mottakerliste
    .AddItem "bXXXX@sXXXXne.no"
    .AddItem "seXXXXnt@oXXXd.no"
    .AddItem "stXXXX9@haXXXXnken.no"
End With


End Sub






Private Sub Cancel_Click()


Unload Me


End Sub
Private Sub Send_Click()


 Dim NSession As Object
    Dim NUIWorkspace As Object
    Dim NMailDb As Object
    Dim NDocumentTemp As Object
    Dim NUIDocumentTemp As Object
    Dim NUIDocument As Object
    Dim NRTItemBody As Object
    Dim NRTStyle As Object, NRTStyleDefault As Object
    Dim NRTItemAttachment As Object, embeddedAttachment As Object
    Dim Subject As String
    Dim SendTo As String, CopyTo As String, BlindCopyTo As String
    Dim fileAttachment As String
    Dim embedCells As Range
    Dim FSO As Object
    Dim tempFolder As String, tempCellsJPG As String
    Dim Copy_and_Paste As Boolean


    Dim kopi1 As String
    Dim kopi2 As String
    Dim kopi3 As String
    Dim kopi4 As String
    
    Dim mmottaker As String, kopitaker As String
    
    MsgBox "For at dette skal gå i orden må jeg be om at du åpner mailen din, og har den oppe på den andre skjermen. Så trykker du OK"
    
    
    If Mottakerliste.Value = "bacXXXXXX@sXXXne.no" Then
        fileAttachment = "G:HKCN-I SettlementKunderSkagenFailed trades2014 Failed Trades" & Format(Date, "mm mmmm") & "" & Format(Date, "yyyymmdd") & " Failed trades" & ".xlsx"
    End If
    If Mottakerliste.Value = "seXXXent@odXXXnd.no" Then
        fileAttachment = "G:HKCN-I SettlementKunderODINFailed trades2014" & Format(Date, "mm mmmm") & "" & "Failed trades " & Format(Date, "ddmmyyyy") & ".xlsx"
    End If
    If Mottakerliste.Value = "sXXXX@haXXXXken.no" Then
        fileAttachment = "G:HKCN-I SettlementKunderSkagenFailed trades2014 Failed Trades" & Format(Date, "mm mmmm") & "" & Format(Date, "yyyymmdd") & " Failed trades" & ".xlsx"
    End If
    
    If checksturla = True Then kopi1 = "XXX@hanXXXXbaXXXen.no"
    If checkmathilde = True Then kopi2 = "mXXX1@hXXXXXanken.no"
    If checkanne = True Then kopi3 = "aXXXX7@hanXXXXXnken.no"
    
    If checksturla = False Then kopi1 = ""
    If checkmathilde = False Then kopi2 = ""
    If checkanne = False Then kopi3 = ""
    
    If customcopy.Value = "" Then
    kopi4 = ""
    Else
    kopi4 = customcopy.Value
    End If
    
    
    
    kopitaker = kopi1 & "," & kopi2 & "," & kopi3 & "," & kopi4
    BlindCopyTo = ""
    Subject = "Falte Handler"
    
    
    


    
    '--------- EDIT USER-DEFINED SETTINGS IN THIS SECTION ---------
    
    'The Excel cells to be included in the email body as an image
    
    'Set embedCells = ActiveSheet.Range("A1:C8")
       
    'The file to be attached to the email, if it exists
    
    
    
  
    
    SendTo = Mottakerliste.Value
    CopyTo = kopitaker
    BlindCopyTo = ""
    Subject = "Ny Macro for mail test!"
    Unload Me
    '--------- END OF USER-DEFINED SETTINGS ---------
    
    'Copy_and_Paste flag
    'True = copy and paste Excel cells into email body using the clipboard
    'False = save Excel cells as a temporary .jpg file and import into email body
    
    'Copy_and_Paste = True
        
    Set FSO = CreateObject("Scripting.FileSystemObject")
    tempFolder = FSO.GetSpecialFolder(2)
    
    'File name for temporary .jpg file containing Excel cells
   
    'tempCellsJPG = tempFolder & "" & Replace(FSO.GetTempName(), ".tmp", ".jpg")
    
    Set NSession = CreateObject("Notes.NotesSession")   'OLE (late binding only) because we access Notes UI classes
    Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
    Set NMailDb = NSession.GetDatabase("", "")
    NMailDb.OPENMAIL
   
    'Create the default rich text style
    
    Set NRTStyleDefault = NSession.CreateRichTextStyle
    With NRTStyleDefault
        .NotesColor = COLOR_BLACK
        .FontSize = 10
        .NotesFont = FONT_HELV
        .Bold = False
        .Italic = False
    End With
    
    Set NRTStyle = NSession.CreateRichTextStyle
   
    'Create a temporary NotesDocument
    
    Set NDocumentTemp = NMailDb.CreateDocument
    With NDocumentTemp
        .Form = "Memo"
        
        'Add a rich text item to contain the email body text and file attachment
        
        Set NRTItemBody = .CreateRichTextItem("Body")
        With NRTItemBody
            
            '--------- ADD/EDIT CODE IN THIS SECTION FOR THE EMAIL BODY TEXT ---------
            
            'Compose the email body text
            
            .AppendText "Hei"
            .AddNewLine 2


            With NRTStyle
                .NotesFont = FONT_ROMAN
                .FontSize = 14
                .NotesColor = COLOR_BLUE
                .Bold = True
            End With
            .AppendStyle NRTStyle
            .AppendText ""
            .AddNewLine 2
        
            'Add placeholder text which will be replaced by the Excel cells
        
            .AppendText ""
            .AddNewLine 2
            
            With NRTStyle
                .NotesFont = FONT_HELV
                .FontSize = 10
                .NotesColor = COLOR_RED
                .Italic = True
            End With
            .AppendStyle NRTStyle
            .AppendText ""
            
            'Same paragraph, default style
            
            .AppendStyle NRTStyleDefault
            .AppendText " Vedlagt følger oversikt over handler som ikke er gjort opp:"
            
            If fileAttachment <> "" Then
                .AddNewLine 2
                .AppendText ""
                .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                .AddNewLine 1
            End If
            
            '--------- END OF EMAIL BODY TEXT SECTION --------
            
        End With
        
        .Save False, False
    End With
   
    'Display the temporary document in the UI
    Application.Wait DateAdd("s", 2, Now)
    On Error GoTo NotesUIfeil
    [COLOR=#ff0000]Set NUIDocumentTemp = NUIWorkspace.EDITDOCUMENT(True, NDocumentTemp)[/COLOR]
   
    'Copy the rich text to the clipboard, close the window, and delete the temp doc
    
    With NUIDocumentTemp
      [COLOR=#ff0000]  .GOTOFIELD "Body"[/COLOR]
        .SelectAll
        .Copy
        'The next 2 lines are not needed
        '.Document.SaveOptions = "0" 'prevent prompt
        '.Document.MailOptions = "0" 'prevent prompt
        .Close                      'therefore temp UI doc not saved
    End With
    NDocumentTemp.Remove True


    'Compose the real email document
    Application.Wait DateAdd("s", 2, Now)
    [COLOR=#ff0000]Set NUIDocument = NUIWorkspace.COMPOSEDOCUMENT(NMailDb.Server, NMailDb.FilePath, "Memo")[/COLOR]
    'Set NUIDocument = NUIWorkspace.ComposeDocument(, , "Memo")      'use local computer and current database
    With NUIDocument
      [COLOR=#ff0000]  .FIELDSETTEXT "EnterSendTo", SendTo[/COLOR]
        .FIELDSETTEXT "EnterCopyTo", CopyTo
        .FIELDSETTEXT "BlindCopyTo", BlindCopyTo
        .FIELDSETTEXT "Subject", Subject


        'The memo now has everything except the rich text from the temporary UI document and the Excel cells image.
        'The automatic signature (if defined in User Preferences) should be at the bottom of the memo.  Now, we just
        'paste the rich text and Excel cells into the body
        
        .GOTOFIELD "Body"
        .Paste
   
        'Replace the placeholder text with the Excel cells image
        
        .GOTOFIELD "Body"
        .FINDSTRING ""
        '.DESELECTALL                   'Uncomment to leave the placeholder text in place (cells are inserted immediately before it)
        
        If Copy_and_Paste Then
            embedCells.CopyPicture xlBitmap
            .Paste
            Application.CutCopyMode = False
        End If
On Error GoTo 0
        'Set NotesDocument options to save and send the email without prompts when the Close method is called
        
        
        
        .Document.SaveOptions = "1"
        .Document.MailOptions = "1"
        
        .Close
        
    End With
    
    MsgBox "Da skal alt ha gått i orden, og mailen er sendt. Er du usikker se i Sent Mail"
    
    Exit Sub
    
    
NotesUIfeil:
    MsgBox "Det ser ut til at Excel jobber for fort for Notes, Spør Sturla hva som kan ha skjedd!"
    
    Exit Sub
    
  
    
End Sub




'Based on http://www.jpsoftwaretech.com/export-excel-range-to-a-picture-file/


Private Sub Save_Object_As_JPG(saveObject As Object, JPGfileName As String)


    'Save a picture of an object as a JPG/JPEG file
    
    'Arguments
    'saveObject     - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
    'JPGfileName    - the file name (including folder path if required) to save the picture as
    
    Dim temporaryChart As ChartObject
     
    Application.ScreenUpdating = False
    
    saveObject.CopyPicture xlScreen, xlPicture
    
    Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width, saveObject.Height)
    With temporaryChart
        .Border.LineStyle = xlLineStyleNone      'No border
        .Chart.Paste
        .Chart.Export JPGfileName
        .Delete
    End With
    
    Application.ScreenUpdating = True
    
    Set temporaryChart = Nothing
    
End Sub










End Sub

Источник

This is a VBA script that allows you to send a Lotus Notes email with VBA from excel. What is new here is that you can write the email in HTML and also attach your standard HTML signature. This seems to have been a major issue with VBA generated Lotus notes emails, as the signature is usually missing. The script also takes the email addresses from an excel spreadsheet.

Below you find the VBA source code and the xlsm file.

Lotus Notes Email

 Sub SendLocalExtensionEmail()
''''''''''''''''''''''''''''''''''
' 2012-12-19
' V 0.2
''''''''''''''''''''''''''''''''''
Dim nMailBody As String
Dim nMailSubject As String
Dim nMailRecipient As Variant
Dim nMail As Object
Dim nSession As Object
Dim nDatabase As Object
Dim nMime As Object
Dim nMailStream As Object
Dim nChild As Object
Dim nSomeMailBodyText As String
Dim amountOfRecipients As Integer

nSomeMailBodyText = "<i> You are looking at some awesome text here!</i>"
nMailRecipient = ""
nMailSubject = "A great email"

Set nSession = CreateObject("Notes.NotesSession")
Set nDatabase = nSession.GetDatabase("", "")
Call nDatabase.OPENMAIL
Set nMail = nDatabase.CreateDocument

'Example on how to get email adresses from a spreadsheet
With ThisWorkbook.Sheets("EmailRecipients")
amountOfRecipients = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
nMailRecipient = ThisWorkbook.Sheets("EmailRecipients").Range("A1:A" & amountOfRecipients).Value
nMail.SendTo = nMailRecipient
nMail.Subject = nMailSubject

nSession.ConvertMIME = False
Set nMime = nMail.CreateMIMEEntity
Set nMailStream = nSession.CreateStream

'vBody contient le texte au format Html
Call nMailStream.WriteText(nSomeMailBodyText)
Call nMailStream.WriteText(" - and again - ")
Call nMailStream.WriteText(nSomeMailBodyText)
Call nMailStream.WriteText("<br>")
Call nMailStream.WriteText("<br>")

'----- READ AND PASTE SIGNATURE -------------------------------------
'Get the standard signature location
nSignatureLocation = nDatabase.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
'nSignatureLocation = "C:disclaimer.htm" 'In case you would like to specify a path to an html file instead
'Required Reference: Windows Script Host Object Model
Dim fso As New FileSystemObject
Dim ts As TextStream
Set ts = fso.OpenTextFile(nSignatureLocation, ForReading)
Dim ThisLine As String
Dim i As Integer
i = 0
Do Until ts.AtEndOfStream
ThisLine = ts.ReadLine
'i = i + 1
'MsgBox ThisLine
Call nMailStream.WriteText(ThisLine)
Loop
ts.Close
'-------------------------------------------------------------------

Set nChild = nMime.CreateChildEntity
Call nChild.SetContentFromText(nMailStream, "text/html;charset=iso-8859-1", ENC_NONE)
Call nMailStream.Close
nSession.ConvertMIME = True
Call nMail.Save(True, True)
'Make mail editable by user
CreateObject("Notes.NotesUIWorkspace").EDITDOCUMENT True, nMail
'Could send it here
End Sub

Источник