I need to automate a report, this is automated almost completely, but in the end of the process it has a specific sheet to be send by email, and they ask for a special format.
I found code that will send the email, but it does not do the same thing that I do when using it manually, "send to mail recipient" button on the Excel ribbon.
This is the code that I am using:
Dim aSheet As Worksheet
Dim Sendrng As Range
Dim rng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sendrng = Worksheets("for_Mail_test").Range("A1:j42")
Set aSheet = ActiveSheet
With Sendrng
.Parent.Select
Set rng = ActiveCell
.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
.Introduction = "This is test mail 2."
With .Item
.To = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "My subject"
.Display
End With
End With
rng.Select
End With
aSheet.Select
StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False
There are two problems:
1 it does not keep the same format that I am on the sheet
2 when I change the method from .send to .display it does not showup
Related
Below is the code, but I also want a test that prevents me from sending an email if Cells B20 and B21 are empty.
Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()
'Working in Excel 2002-2016
Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Worksheets("Sheet1").Range("A1:B21")
'Remember the activesheet
Set AWorksheet = ActiveSheet
With Sendrng
' Select the worksheet with the range you want to send
.Parent.Select
'Remember the ActiveCell on that worksheet
Set rng = ActiveCell
'Select the range you want to mail
.Select
' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = "Please see Quality Review Sev 1 details below."
With .Item
.To = "danielle.a.ext#razer.com"
.CC = ""
.BCC = ""
.Subject = Range("E2").Value
.send
End With
End With
MsgBox "Email Sent"
'select the original ActiveCell
rng.Select
End With
'Activate the sheet that was active before you run the macro
AWorksheet.Select
StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False
End Sub
Test for the condition and use Exit Sub to end the sub routine.
If Len(Range("B20").Value) = 0 Or Len(Range("B21").Value) = 0 Then Exit Sub
I am working on an Excel workbook to track appointments and to send an email to advise of the appointment.
I put together code to open an email in Outlook with inputs pulled from the Excel sheet.
Sub ButtonREMINDER41_Click()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
' Only send the visible cells in the selection.
Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set rng =
Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, xlTextValues)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
`Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Range("$F$41")
.CC = Range("$B$41")
.BCC = ""
.Subject = "Upcoming Scheduled Appointment"
.HTMLBody = Range("$N$41")
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
I am trying to also book an appointment in the receiver's calendar.
I would like an email generated with a meeting attachment for the appointment.
I have a worksheet ("WC Referral Notice") that I need to put into the body of an email, but NOT send it immediately since I need to browse and attach several documents to the email before it is sent. I found macros to send it in the body of the email but it's sent as soon as you click. And I've also found macros to attach the workbook as an attachment. Neither of those are exactly what I'm looking for.
Sub Send_Selection_Or_ActiveSheet_with_MailEnvelope()
Dim Sendrng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sendrng = Selection
With Sendrng
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
.Introduction = " "
With .Item
.To = "adicker#generic.com"
.CC = ""
.BCC = ""
.Subject = "WC Referral Notice"
.Send
End With
End With
End With
StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False
End Sub
Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()
Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Worksheets("WC Referral Notice").Range("A1:H101")
'Remember the activesheet
Set AWorksheet = ActiveSheet
With Sendrng
' Select the worksheet with the range you want to send
.Parent.Select
'Remember the ActiveCell on that worksheet
Set rng = ActiveCell
'Select the range you want to mail
.Select
' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = "This is test mail 2."
With .Item
.To = "adicker#generic.com"
.CC = ""
.BCC = ""
.Subject = "Blah Blah"
.Item.Send
End With
End With
'select the original ActiveCell
rng.Select
End With
'Activate the sheet that was active before you run the macro
AWorksheet.Select
StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'ActiveWorkbook.EnvelopeVisible = False
End Sub
Copy All Visible(Formatted Text) from Excel to Outlook using VBA?
Please find below code to send email through outlook. However, I want to send the email with a selection that I have copied below using code.
I do not wish to create a Table as HTML but instead just copy all visible?
Sub EmailRep()
Dim Mailbody As Range
Application.DisplayAlerts = False
Dim Outlook As Outlook.Application
Set Outlook = CreateObject("Outlook.Application")
Dim outmail As MailItem
Set outmail = Outlook.CreateItem(0)
Set Mailbody = ActiveWorkbook.Worksheets("Dashboard").Range("A1:F30")
Mailbody.Copy
With outmail
.To = "abc#xyz.com"
.Subject = "All Open"
.Body = "This is Test Email"
.Display
.Send
End With
Set Outlook = Nothing
Set outmail = Nothing
Set Mailbody = Nothing
End Sub
If I understand correct change your line of :
Set Mailbody = ActiveWorkbook.Worksheets("Dashboard").Range("A1:F30")
To
Set Mailbody = ActiveWorkbook.Worksheets("Dashboard").Range("A1:F30").SpecialCells(xlCellTypeVisible)
Although in your code you are not putting the range into the body of the email. At first thought you pasted the range by hand but then I noticed you have .Send in code which would send the email before you got a chance to paste.
Either way the above will copy only the visible range.
If you are interested in a quick way to send your range in an email without the need to copy the below is pretty short and sweet:
Sub EmailRep()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Range("A1:F30").SpecialCells(xlCellTypeVisible).Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = "This is Test Email"
.Item.To = "abc#xyz.com"
.Item.Subject = "All Open"
.Item.Send
End With
ActiveWorkbook.EnvelopeVisible = False
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
I have code to take a copy of a select worksheet but am haveing difficulties directing which draft folder in outlook to send the draft email to. The name of the folder I want to send the draft email to is "Draft NDIC". Here is the code:
Sub Mail_Body_NDIC()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
Set rng = Sheets("NDIC Renewals").UsedRange
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "dvandervieren#enerplus.com"
.CC = ""
.BCC = ""
.Subject = "NDIC Renewals for the Next 90 Days"
.Body = ""
.HTMLBody = RangetoHTML(rng)
.Save 'or use .Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
"You need to use the .Move method, with the olDestFolder as the argument." David Van der Vieren
http://blog.saieva.com/2010/03/27/move-messages-to-folders-with-outlook-vba/