Send the active sheet or Range of cells as mail

[brt21]

Hi,#
I use the following code to send mail to a person through lotus notes. But i want to send a specific page or the Range like (A1 : K50) as an attachment. Someone please help me to alter the code so that it works in the way i want it to.

Public Sub CommandButton21_Click()

    Dim Maildb As Object
    Dim MailDoc As Object
    Dim Body As Object
    Dim Session As Object
    'Start a session of Lotus Notes
        Set Session = CreateObject("Lotus.NotesSession")
    'This line prompts for password of current ID noted in Notes.INI
        Call Session.Initialize
    
'or use below to provide password of the current ID (to avoid Password prompt)
        'Call Session.Initialize("<password>")

    'Open the Mail Database of your Lotus Notes
        Set Maildb = Session.GETDATABASE("", "C:\Users\janabh1\AppData\Local\Lotus\Notes\Data\mail\Lippstadt\janabh1.nsf")
        If Not Maildb.IsOpen = True Then Call Maildb.Open

    'Create the Mail Document
        Set MailDoc = Maildb.CREATEDOCUMENT
        Call MailDoc.REPLACEITEMVALUE("Form", "Memo")

    'Set the Recipient of the mail
        Call MailDoc.REPLACEITEMVALUE("SendTo", "Bharathwaj Janaki Krishnamoorthi")

    'Set subject of the mail
        Call MailDoc.REPLACEITEMVALUE("Subject", "Data")

    'Create and set the Body content of the mail
        Set Body = MailDoc.CREATERICHTEXTITEM("Body")
        Call Body.APPENDTEXT("Please ignore the message")

    'Example to create an attachment (optional)
        Call Body.ADDNEWLINE(2)
        Call Body.EMBEDOBJECT(1454, "", "C:\Users\janabh1\Desktop\Prüfungen.xlsx\", "Attachment")

    'Example to save the message (optional) in Sent items
        MailDoc.SAVEMESSAGEONSEND = True

    'Send the document

    'Gets the mail to appear in the Sent items folder
        Call MailDoc.REPLACEITEMVALUE("PostedDate", Now())
        Call MailDoc.SEND(False)

    'Clean Up the Object variables - Recover memory
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set Body = Nothing
        Set Session = Nothing

End Sub

 

[John_w]

Save the range as an image file - http://www.mrexcel.com/forum/excel-...-table-out-excel-into-folder.html#post4249302 - and attach the file.

 

[brt21]

Hello John,

Thanks for the response. i used that idea and slightly changed my code, referring to several templates. here, the concept is to save the active sheet as a temporary Pdf, send it as a mail attachment and delete the file.

Private Sub email_Click()
      
'Do not forget to change the email ID
'before running this code
      
    Dim Session As Object
    Dim Maildb As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileFullPath As String
      
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
      
' Temporary file path where pdf
' file will be saved before
' sending it in email by attaching it.
      
    TempFilePath = Environ$("C:\") & "\"
     
' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.
     
    TempFileName = ActiveSheet.Name & "-" & ".pdf"
     
'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName
     
'Now Export the Activesshet as PDF with the given File Name and path
     
    On Error GoTo err
    With ActiveSheet
        .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=FileFullPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With
     
'Now open a new mail
     
'Start a session of Lotus Notes
        Set Session = CreateObject("Lotus.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
        Call Session.Initialize
    
'or use below to provide password of the current ID (to avoid Password prompt)
        'Call Session.Initialize("
")

'Open the Mail Database of your Lotus Notes
        Set Maildb = Session.GETDATABASE("", "C:\Users\xxx.nsf")
        If Not Maildb.IsOpen = True Then Call Maildb.Open
    Set NewMail = Session.CreateItem(0)
     
    On Error Resume Next
    With NewMail
        .To = "aaa@bbb.com"
        .CC = ""
        .BCC = ""
        .Subject = "subject"
        .Body = "Type the Body of your mail"
        .Attachments.Add FileFullPath '--- full path of the pdf where it is saved
        .Send   'or use .Display to show you the email before sending it.
    End With
    On Error GoTo 0
     
'Since mail has been sent with the attachment
'Now delete the pdf file from the temp folder
     
    Kill FileFullPath
     
'set nothing to the objects created
    Set NewMail = Nothing
    Set OlApp = Nothing
     
'Now set the application properties back to true
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox ("Email has been Sent Successfully")
    Exit Sub
err:
        MsgBox err.Description
  
End Sub

Now, I encounter a different problem. when i click the command button, i could see a pop up saying 'Document not saved. the document may be open or an error may have been encountered while saving'.
I looked for it in google but the solutions provided wouldnt help. Please see if you can figure out the problem.</password>

 

[John_w]

I assume the error is caused by the ExportAsFixedFormat statement to save the sheet as a PDF. For future reference, if you click Debug on the error message window then the line which caused the error is highlighted in yellow in the VBA editor.

Is FileFullPath a valid folder path and file name?

Try changing the Environ$ line to:

Environ$("temp") & "\"

 

[brt21]

the Environ command is associated with TempFilePath where I must mention the path which is to be concatenated with TempFileName and it renders the FileFullPath. i just edited this code a little bit and just provided the skeleton of the code. i dont find any such yellow highlighted lines in my code. i just checked with the ExportAsFixedFormat.

https://msdn.microsoft.com/en-us/library/bb238907(v=office.12).aspx

I guess the code i used is right. And i wont be able to get back to the editor when i click the command button.

 

[brt21]

i did quite some mistakes in my code.. i corrected it and this is the new one.

Private Sub CommandButton21_Click()
     
'Do not forget to change the email ID
'before running this code
     
    Dim Maildb As Object
    Dim MailDoc As Object
    Dim Body As Object
    Dim NewMail As Object
    Dim Session As Object
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileFullPath As String
     
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
     
' Temporary file path where pdf
' file will be saved before
' sending it in email by attaching it.
     
    TempFilePath = Environ$("temporary folder") & "\"
    
' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.
    
    TempFileName = ActiveSheet.Name & ".pdf"
    
'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName
    
'Now Export the Activesshet as PDF with the given File Name and path
    
    On Error GoTo err
    With ActiveSheet
    .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=FileFullPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With
    
'Now open a new mail
    
'Start a session of Lotus Notes
        Set Session = CreateObject("Lotus.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
        'Call Session.Initialize
   
'or use below to provide password of the current ID (to avoid Password prompt)
        Call Session.Initialize("password")

'Open the Mail Database of your Lotus Notes
        Set Maildb = Session.GETDATABASE("", "xxx.nsf")
        If Not Maildb.IsOpen = True Then Call Maildb.Open
   
'Create the Mail Document
        Set MailDoc = Maildb.CREATEDOCUMENT
        Call MailDoc.REPLACEITEMVALUE("Form", "Memo")

'Set the Recipient of the mail
        Call MailDoc.REPLACEITEMVALUE("SendTo", "yyy")

'Set subject of the mail
        Call MailDoc.REPLACEITEMVALUE("Subject", "Data")

'Create and set the Body content of the mail
        Set Body = MailDoc.CREATERICHTEXTITEM("Body")
        Call Body.APPENDTEXT("Please ignore the message")
        
'Example to create an attachment (optional)
        Call Body.ADDNEWLINE(2)
        Call Body.EMBEDOBJECT(1454, "", FileFullPath, "Attachment")

'Example to save the message (optional) in Sent items
        MailDoc.SAVEMESSAGEONSEND = True
    
'Since mail has been sent with the attachment
'Now delete the pdf file from the temp folder
    
    Kill FileFullPath
    
'set nothing to the objects created
    Set MailDoc = Nothing
    Set Session = Nothing
    
'Now set the application properties back to true
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox ("Email has been Sent Successfully")
    Exit Sub
err:
        MsgBox err.Description
 
End Sub

Still 'Document not saved..............................' appears. So, it appears to have no relation with the code

 

[John_w]

    TempFilePath = Environ$("temporary folder") & "\"

Is the "temporary folder" environment variable defined on your computer? My amendment uses the "temp" environment variable which is usually defined on every Windows computer.

You will have to comment out the On Error GoTo err line in order to see the default error message window with the Debug button which will allow you to enter the running code and examine variables and step through it by pressing the F8 key.

I have seen the "Document not saved ...." error with ExportAsFixedFormat, seemingly for no logical reason, as executing the line again usually succeeds.

 

[brt21]

Thanks a lot John. Atlast this code works!

Option Explicit
 
Const EMBED_ATTACHMENT As Long = 1454

Const stPath As String = "C:\Temp"

Const stSubject As String = "Order"

Const vaMsg As Variant = "The file contains the order. Please proceed as requested" & vbCrLf & _
                                          "Kind regards," & vbCrLf & _
                                           "Bharath"

Const vaCopyTo As Variant = "xxx@yyy.com"

Private Sub Send_order_Click()
 

    Dim vaRecipients As Variant
    Dim noSession As Object
    Dim noDatabase As Object
    Dim noDocument As Object
    Dim noEmbedObject As Object
    Dim noAttachment As Object
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileFullPath As String
  
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
     
' Temporary file path where pdf
' file will be saved before
' sending it in email by attaching it.
     
    TempFilePath = Environ$("temp") & "\"
    
' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.
    
    TempFileName = ActiveSheet.Name & ".pdf"
    
'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName
    
'Now Export the Activesshet as PDF with the given File Name and path
    
    'On Error GoTo err
    With ActiveSheet
    .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=FileFullPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With
 
  
  'Create the list of recipients.
  vaRecipients = "xxx"
 
  'Instantiate the Lotus Notes COM's Objects.
  Set noSession = CreateObject("Notes.NotesSession")
  Set noDatabase = noSession.GETDATABASE("", "aaa.nsf")
 
  'If Lotus Notes is not open then open the mail-part of it.
  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
  'Create the e-mail and the attachment.
  Set noDocument = noDatabase.CreateDocument
  Set noAttachment = noDocument.CreateRichTextItem("FileFullPath")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", FileFullPath)
 
  'Add values to the created e-mail main properties.
  With noDocument
    .Form = "Memo"
    .SendTo = vaRecipients
    .CopyTo = vaCopyTo
    .Subject = stSubject
    .Body = vaMsg
    .SaveMessageOnSend = True
    .PostedDate = Now()
    .Send 0, vaRecipients
  End With
 
  'Delete the temporarily workbook.
  Kill FileFullPath
 
  'Release objects from memory.
  Set noEmbedObject = Nothing
  Set noAttachment = Nothing
  Set noDocument = Nothing
  Set noDatabase = Nothing
  Set noSession = Nothing
 
  MsgBox "The order has been successfully placed", vbInformation
 
End Sub