Conditional Sheet Attachment

[Todd Huttenstine]

Combobox1 is populated with sheet names. The user will
select a sheetname from the combobox.

What is the code that will attach the sheet that is in
combobox1 and bring up an outlook email dialog box. I
want the email dialog box to have the subject of "Stats"
and an empty body and To address field.

For example, the user clicks the combobox and selects the
value "Todd Huttenstine". When the code is run, it must
attach worksheet "Todd Huttenstine" to the email.

Below is the code I have so far, but I want my email
address taken out. When I take it out I get an error.

Can anyone please show me the modified code to perform the
task?



Option Explicit
Private Sub CommandButton1_Click()
Dim objSession As Object, objMessage As Object,
objOneRecip As Object
Set objSession = CreateObject("MAPI.Session")
objSession.Logon
Set objMessage = objSession.Outbox.Messages.Add
objMessage.Subject = "Stats"
objMessage.Text = ""
Set objOneRecip = objMessage.Recipients.Add
objOneRecip.Name = "(e-mail address removed)"
objOneRecip.Type = 1
objOneRecip.Resolve
objMessage.Send showDialog:=True
objSession.Logoff


End Sub

Thank you

Todd Huttenstine

 

[Tom Ogilvy]

Do you mean when you remove these lines of code

Set objOneRecip = objMessage.Recipients.Add
objOneRecip.Name = "(e-mail address removed)"
objOneRecip.Type = 1
objOneRecip.Resolve
objMessage.Send showDialog:=True
objSession.Logoff

You get an error?

 

[Todd uttenstine]

No when I remove
the "(e-mail address removed)" out of that
line and only put "".

 

[Tom Ogilvy]

That isn't how you would leave the to address blank. You would need to at
least remove/comment out the lines

Set objOneRecip = objMessage.Recipients.Add
objOneRecip.Name = "(e-mail address removed)"
objOneRecip.Type = 1
objOneRecip.Resolve

 

[Todd Huttenstine]

Tom, that worked. Thank you. Below is the modified code.
Combobox1 contains sheet names. I need for it to look in
Combobox1, and attach that sheet to the email. How would
I do this? For example the value "Todd Huttenstine" is in
combobox1. Therefore I need for it to attach sheet "Todd
Huttenstine" to the email.


Option Explicit
Private Sub CommandButton1_Click()
Dim objSession As Object, objMessage As Object,
objOneRecip As Object
Set objSession = CreateObject("MAPI.Session")
objSession.Logon
Set objMessage = objSession.Outbox.Messages.Add
objMessage.Subject = "Stats"
objMessage.Text = ""
'Set objOneRecip = objMessage.Recipients.Add
'objOneRecip.Name = "(e-mail address removed)"
'objOneRecip.Type = 1
'objOneRecip.Resolve
objMessage.Send showDialog:=True
objSession.Logoff


End Sub

 

[Tom Ogilvy]

I will have to assume that objMessage has an Attachments collection:

If so, it would be something like:

Option Explicit
Private Sub CommandButton1_Click()
Dim sStr as String
sStr = Listbox1.Value
worksheets(sStr).Copy
ActiveWorkbook.SaveAs "C:\" & sStr & ".xls", _
FileFormat:=xlWorkbookNormal
ActiveWorkbook.Close SaveChanges:=False
Dim objSession As Object, objMessage As Object,
objOneRecip As Object
Set objSession = CreateObject("MAPI.Session")
objSession.Logon
Set objMessage = objSession.Outbox.Messages.Add
objMessage.Subject = "Stats"
objMessage.Text = ""
'Set objOneRecip = objMessage.Recipients.Add
'objOneRecip.Name = "(e-mail address removed)"
'objOneRecip.Type = 1
'objOneRecip.Resolve
objMessage.Attachments.Add "C:\" & sStr & ".xls"
objMessage.Send showDialog:=True
objSession.Logoff
On Error Resume Next
kill "C:\" & sStr & ".xls"
On Error goto 0
End Sub

 

[Todd Huttenstine]

it worked but the file is not an Excel file and when I
opened it it does not work.

 

[Tom Ogilvy]

ActiveWorkbook.SaveAs "C:\" & sStr & ".xls", _
saves it as a workbook if you are in Excel and xlWorkbookNormal is a defined
constant. If not, try changing the argument to its constant value
? xlworkbooknormal
-4143

 

[Todd Huttenstine]

I made the following changes to the code and now it works.

Thank you for your help.

Dim sStr As String
Dim objAttachmt As Object
sStr = ComboBox1.Value
Worksheets(sStr).Copy
ActiveWorkbook.SaveAs "C:\Stats.xls", _
FileFormat:=xlWorkbookNormal
ActiveWorkbook.Close SaveChanges:=False
Dim objSession As Object, objMessage As Object,
objOneRecip As Object
Set objSession = CreateObject("MAPI.Session")
objSession.Logon
Set objMessage = objSession.Outbox.Messages.Add
objMessage.Subject = "Stats"
objMessage.Text = ""
'Set objOneRecip = objMessage.Recipients.Add
'objOneRecip.Name = "(e-mail address removed)"
'objOneRecip.Type = 1
'objOneRecip.Resolve
'objMessage.Attachments.Add "C:\Stats.xls"
Set objAttachmt = objMessage.Attachments.Add
objAttachmt.Source = ("C:\Stats.xls")
objMessage.Send showDialog:=True
objSession.Logoff
On Error Resume Next
Kill "C:\Stats.xls"
On Error GoTo 0