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.
Related
I would like to generate an email using a macro that I don't have to copy and paste the resulting data in the body of the email and attach the file. The worksheet pulls data from other worksheets and I use Excel functions to generate the syntax. So far the code I've used will only generate the email, subject line, and attachment but no body text. I am unable to show a photo or show the code.
Sub Send_Mail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
On Error Resume Next
Set rng = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
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
End With
For Each cell In rng
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "test mail"
The following code allows me to select a range of cells using in a range of a excel sheet and send that as an email. However, pictures or images withing the range are not selected. How do i do that
Sub Mail_Selection_Range_Outlook_Body()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2016
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
'Set rng = Nothing
' On Error Resume Next
'Only the visible cells in the selection
'Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a fixed range if you want
Set rng = Sheets("Sheet1").Range("B8:M108").SpecialCells(xlCellTypeVisible)
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 = Worksheets("Email").Range("A10").Value
.CC = Worksheets("Email").Range("B10").Value
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Send '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
I have found the following Macro and used it to my needs to copy range and create an email, I have copied the same code into several sheets, couple of things change in each code the range, email addresses & subject. How can I stack all these macros into one:
Sub Macro_Qu()
'
' Macro_Qu Macro
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Qusai").Range("A2:J20").SpecialCells(xlCellTypeVisible)
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
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Qu#msn.com"
.CC = ""
.BCC = ""
.Subject = "Test"
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Just pass the values that change as parameters:
Sub Test
Macro_Qu Sheets("Qusai").Range("A2:J20"), "Qu#msn.com", "Test"
End Sub
Sub Macro_Qu(parmRng As Range, parmTo As String, parmSubject As String)
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
On Error Resume Next
Set rng = parmRng.SpecialCells(xlCellTypeVisible)
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
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = parmTo
.CC = ""
.BCC = ""
.Subject = parmSubject
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You can use this to call other macros from inside another macro:
call <macro name>
However, if you're starting to get this complex it might be time to learn VBA :)
Excel will have a list of different dates and receivers' email ids across each date.
If the cell has a specific date, an auto-email will be sent to the email ids mentioned across it.
The mail is to be sent through Outlook.
Pretty general question but lets first talk about the possible approach.
1. Get date from cells in a loop
2. If date matches with a particular date, call a sub to send mail
3. Pass corresponding mail ids in parameter (of the sendMail method) to send mail
I won't be able to give you exact code but here is roughly how it will be:
For i = 1 to n
strDate = workbooks.worksheet("Sheet1").cells(i,1)
emailList = workbooks.worksheet("Sheet1").cells(i,2)
if (strDate=expectedDate) then
call sendMail(emailList)
end if
Next
Public function sendMail(emailList)
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
On Error GoTo err
'Now open a new mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailList
.CC = ""
.Subject = "test"
.Body = "the content of the mail"
End With
On Error GoTo 0
'set nothing to the objects created
Set OutMail = Nothing
Set OutApp = 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 function
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/