troubleshooting Question

Unable to send mail from Lotus notes 8.5 with excel vba

Avatar of sajeevn
sajeevn asked on
Programming Theory
15 Comments1 Solution3231 ViewsLast Modified:
Hi Team,

I hav this piece of code which sends mails with attachments in excel 2007 using lotus notes 8, however i am unable to send mails in lotus notes 8.5 with this code, appreciate any help.



Public Sub Send_Testemail()

'Requires reference to Lotus Domino Objects (domobj.tlb) for constants such as EMBED_ATTACHMENT and FONT_HELV, etc.

Application.DisplayAlerts = False
Application.ScreenUpdating = False

   
 
    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
    Const EMBED_ATTACHMENT As Long = 1454
    Dim Name1 As String
   
   
    '--------- EDIT USER-DEFINED SETTINGS IN THIS SECTION ---------
   
   

   
   
   
 
     
     
   
    Set embedCells = Sheets("Draft").Range(Cells(1, 1), Cells(ActiveCell.Row, ActiveCell.Column + 3))
   
 
     SendTo = Sheets("Values").Range("B2").Value
   
   
   ' SendTo = "sajeev.nair@xe04.ey.com"
    CopyTo = ""
    BlindCopyTo = ""
    Subject = "EY Training Courses"
   
    '--------- 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 = False
       
    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_BLUE
       ' .FontSize = 8
       ' .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 ""
           ' .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 "{PLACEHOLDER}"
           ' .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 "  Excel cells are shown above."
           
           
           
         fileAttachment = "C:/Training/Training Planner.pdf"
           
            If fileAttachment <> "" Then
               ' .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
           
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
             '
            End If
           
           
           
           
            fileAttachment = Sheets("Values").Range("H2").Value
           
            If fileAttachment <> "" Then
               ' .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
               '
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                '
            End If
           
           fileAttachment = Sheets("Values").Range("H3").Value
           
        If fileAttachment <> "" Then
              '  .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
              '  .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
               ' .AddNewLine 1
            End If
           
           
            fileAttachment = Sheets("Values").Range("H4").Value
           
        If fileAttachment <> "" Then
              '  .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
               ' .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                '.AddNewLine 1
            End If
           
           
           
           
              fileAttachment = Sheets("Values").Range("H5").Value
           
        If fileAttachment <> "" Then
              '  .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
               ' .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                '.AddNewLine 1
            End If
           
           
           
              fileAttachment = Sheets("Values").Range("H6").Value
           
        If fileAttachment <> "" Then
              '  .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
               ' .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                '.AddNewLine 1
            End If
           
           
              fileAttachment = Sheets("Values").Range("H7").Value
           
        If fileAttachment <> "" Then
              '  .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
               ' .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                '.AddNewLine 1
            End If
           
           
              fileAttachment = Sheets("Values").Range("H8").Value
           
        If fileAttachment <> "" Then
              '  .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
               ' .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                '.AddNewLine 1
            End If
           
           
              fileAttachment = Sheets("Values").Range("H9").Value
           
        If fileAttachment <> "" Then
              '  .AddNewLine 2
               ' .AppendText fileAttachment & " attached"
               ' .AddNewLine 1
                .EmbedObject EMBED_ATTACHMENT, "", fileAttachment
                '.AddNewLine 1
            End If
           
           
              fileAttachment = Sheets("Values").Range("H10").Value
           
        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
   
   
   
 On Error GoTo errhandler
     
   
    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
   
 DoEvents
 
 

 
MailStatus
 
Sheets("TrainingForm").Select



    Set NSession = Nothing
    Set NUIWorkspace = Nothing
    Set NMailDb = Nothing
    Set NRTItemBody = Nothing
    Set NRTStyle = Nothing
    Set NRTItemAttachment = Nothing
    Set embeddedAttachment = Nothing
    Set NRTStyleDefault = Nothing


errhandler:
If Err.Number = 7742 Then
MsgBox "Lotus notes error"
End If



Application.DisplayAlerts = True
Application.ScreenUpdating = True

 

DoEvents
End Sub


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
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 15 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 15 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros