jularobert
New Member
- Joined
- Nov 26, 2013
- Messages
- 11
Hello All.
I have a workbook that sends a copy via Lotus Notes. The body of the e-mail is text from the excel workbook. Unfortunately it does not look good and I would like to change the code to paste either as HTML, Jpeg or some option to make it readable for recipients without the need to open the excel attachment.
Here is my code:
Appreciate any and all help.
I have a workbook that sends a copy via Lotus Notes. The body of the e-mail is text from the excel workbook. Unfortunately it does not look good and I would like to change the code to paste either as HTML, Jpeg or some option to make it readable for recipients without the need to open the excel attachment.
Here is my code:
Appreciate any and all help.
VBA Code:
Sub SendActiveSheet()
Dim stFileName As String
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 stAttachment As String
Dim EMBED_ATTACHMENT As Long
Dim bodytext As String
Dim vaCopyTo As Variant
Dim myArr As Variant
Dim emailto As Variant
Dim wb1 As Workbook, wb2 As Workbook
Dim stSubject As String
Dim vDay As Integer
Dim rng As Range
Dim cell As Range
Dim rngText As String
' Confirmation before sending
If MsgBox("Are you sure you want to send this report?", vbOKCancel) = vbCancel Then Exit Sub
Application.DisplayAlerts = False
ActiveWorkbook.Unprotect Password:=PW
Select Case ActiveSheet.Range("N15").Value
' Match the day value
Case 1 To 20
vDay = ActiveSheet.Range("N15").Value
Case Else
vDay = 0
End Select
EMBED_ATTACHMENT = 1454
' Define the range to copy (adjust the range as needed)
Set rng = ActiveSheet.Range("A1:U20")
' Convert the range to text by looping through each cell
rngText = ""
For Each cell In rng
rngText = rngText & cell.Value & vbTab
If cell.Column = rng.Columns.Count Then
rngText = rngText & vbNewLine
End If
Next cell
' Prepare email body with the range text
bodytext = "Good Morning," & vbNewLine & vbNewLine
bodytext = bodytext & "Attached above is the report from last night." & vbNewLine & vbNewLine
bodytext = bodytext & "Below is a summary of the report:" & vbNewLine & vbNewLine
bodytext = bodytext & rngText & vbNewLine & vbNewLine
bodytext = bodytext & "Thanks," & vbNewLine
bodytext = bodytext & "The C Team" & vbNewLine & vbNewLine
bodytext = bodytext & "This is a system generated email."
Set wb1 = ThisWorkbook
stSubject = "Daily Report - Day " & vDay
' Copy the active sheet to a new temporary workbook.
With ActiveSheet
.Copy
stFileName = "Daily Report.xlsm"
End With
stAttachment = stPath & stFileName
' Save and close the temporary workbook.
Set wb2 = ActiveWorkbook
wb2.ActiveSheet.Unprotect Password:=PW
With wb1.ActiveSheet
.Unprotect Password:=PW
.Range("A1:U200").Copy Destination:=wb2.ActiveSheet.Range("A1")
.Protect Password:=PW, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True
.EnableSelection = xlNoRestrictions
End With
With wb2
.SaveAs stAttachment, FileFormat:=52
.Close
End With
' Create the list of recipients.
Set emailto = Worksheets("Setup").Range("F13")
Set myArr = Worksheets("Setup").Range("F15:F54")
vaRecipients = emailto
vaCopyTo = myArr
' Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
' 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("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
' Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Subject = stSubject
.Body = bodytext
.SaveMessageOnSend = False
.PostedDate = Now()
.Send 0, vaRecipients
End With
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=PW
' Delete the temporary workbook.
Kill stAttachment
' Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "The Daily Report has been successfully detached and e-mailed to the R", vbInformation
Application.DisplayAlerts = True
End Sub
Last edited by a moderator:
