Troubles sending an email from excel

[peter_z]

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!

 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

 

[JoeMo]

Try this:

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]

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:

 Application.Dialogs(strOutput).Show

To do this?

 

[JoeMo]

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]

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]

Problem solved!

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

Changed

 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