Troubles sending an email from excel

peter_z

Board Regular
Joined
Feb 27, 2011
Messages
87
Hey Guys, I have some code below which was sending an email containing an attachment to a whole bunch of recipients that were listed in excel. I now need to change that code so that the email just contains the attached file and lets the user send to who ever they want to manually imput in outlook.

Can anyone assist me with the code that opens the outlook email with the attachment and allows the user to type in the email addresses they wish to send it to?

Cheers!

Code:
 Sub SendEmails()
Dim aOutlook As Object
Dim aEmail As Object, x As Long
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim lngCount As Long
Dim strdate As Date, strtitle As String, StrSource As String, strOutput As String
Dim strImage As String, strImage2 As String
Dim colAttach As Object
Dim oAttach As Object
'Set Variables
strUNC = "PATH FOR WHERE THE FILE IS KEPT"
StrSource = "SHEET_1"
strtitle = "SHEET_2"
'Set File Name
strOutput = "NAME_OF_FILE"
'Debug.Print strOutput
strOutput = strUNC & strOutput
'Set the date for the email title
strdate = Worksheets(strtitle).Range("I8").Value
'set outlook
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'set Importance
aEmail.Importance = 2
'Set Subject
aEmail.Subject = "SUBJECT"
'Set Body for mail
aEmail.body = "Please log onto the MIS v2 system to check status (( Indicator List))" 

aEmail.Attachments.Add strOutput
aEmail. ???????
End Sub
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,410
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Try this:
Code:
Sub SendEmailWithThisWorkbookAttached()
On Error Resume Next
Application.Dialogs(xlDialogSendMail).Show
If Err.Number <> 0 Then
    MsgBox "Problem sending this report by email - ensure email is open and try again."
    Exit Sub
End If

End Sub
Code should be in a module within the workbook you want to attach to the email. You can add code to save the workbook before sending, etc.
 

peter_z

Board Regular
Joined
Feb 27, 2011
Messages
87
Thanks JoeMo, that code does half of what I need.
My code is taking 2 sheets out of the workbook and sending it.

Is there a way to alter:

Code:
 Application.Dialogs(strOutput).Show

To do this?
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,410
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
That won't work unless strOutput is an xlDialogs constant. Why not do the following:
1. Save the workbook in its pre-email state.
2. Delete all sheets except the ones you want to email.
3. Rename the (active) workbook using a SaveAs and filename that identifies it as the email version.
4. Add the code I posted to send this workbook by email.
 

peter_z

Board Regular
Joined
Feb 27, 2011
Messages
87
That won't work unless strOutput is an xlDialogs constant. Why not do the following:
1. Save the workbook in its pre-email state.
2. Delete all sheets except the ones you want to email.
3. Rename the (active) workbook using a SaveAs and filename that identifies it as the email version.
4. Add the code I posted to send this workbook by email.

I've now got some code saving the worksheets I want to a new workbook.
The file name is dim strOutput
Location of the file is pathed under dim strUNC

Is it possible to add this on the xlDialogs constant without deleting the sheets?

Cheers
 

peter_z

Board Regular
Joined
Feb 27, 2011
Messages
87
Problem solved!

Don't know why I didn't figure this out earlier actually...

Changed


Code:
 Sub SendEmails()
Dim aOutlook As Object
Dim aEmail As Object, x As Long
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim lngCount As Long
Dim strdate As Date, strtitle As String, StrSource As String, strOutput As String
Dim strImage As String, strImage2 As String
Dim colAttach As Object
Dim oAttach As Object
'Set Variables
strUNC = "PATH FOR WHERE THE FILE IS KEPT"
StrSource = "SHEET_1"
strtitle = "SHEET_2"
'Set File Name
strOutput = "NAME_OF_FILE"
'Debug.Print strOutput
strOutput = strUNC & strOutput
'Set the date for the email title
strdate = Worksheets(strtitle).Range("I8").Value
'set outlook
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'set Importance
aEmail.Importance = 2
'Set Subject
aEmail.Subject = "SUBJECT"
'Set Body for mail
aEmail.body = "Please log onto the MIS v2 system to check status (( Indicator List))" 

aEmail.Attachments.Add strOutput
[COLOR=red][B]aEmail.Display 
[/B][/COLOR]End Sub


Now it works exactly to how I need it to cheers for your help JoeMo
 

Watch MrExcel Video

Forum statistics

Threads
1,126,939
Messages
5,621,719
Members
415,853
Latest member
Newlife72

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top