I have the following code of which I have a button on a excel worksheet that is supposed to email the active sheet. I can get the email. I can even get attachments. I just can't get it to work properly with the active sheet. Any help would be greatly appreciated.

Thanks


Sub SendMail()



Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full Email Address"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Password"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With

strbody = "Attached you will find last nights numbers"
& vbNewLine
& vbNewLine & _
"Thanks" & vbNewLine & _
& vbNewLine & _
"Lee"

ActiveWorkbook.save

CurrFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

With iMsg
Set .Configuration = iConf
.To = EmailAddress@gggg.com
.CC = ""
.BCC = ""
.From = """Name"" <Email@Email.com>"
.Subject = "Closing Numbers"
.Attachment.Add = CurrFile
.Send
End With
End Sub

I have it fixed but when you recieve the email it is losing some of the information in the spreadsheet. All the code and macros are still there. It loses whatever data that was in the sheet and the formatting. Any suggestions?

Sub EmailSheet_Click()

ActiveWorkbook.SaveCopyAs Filename:="c:\Temp1\Closing Sheet Email.xls"

Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "******@Gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*****"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With

strbody = "Hi there"

With iMsg
Set .Configuration = iConf
.To = "****@123.com"
.CC = ""
.BCC = ""
' Note: The reply address is not working if you use this Gmail example
' It will use your Gmail address automatic. But you can add this line
' to change the reply address .ReplyTo = "Reply@something.nl"
.From = """******"" <*****@gmail.com>"
.Subject = "Closing Numbers"
.AddAttachment "c:\Temp1\Closing Sheet Email.xls"
.send

Kill "c:\Temp1\Closing Sheet Email.xls"

ActiveWorkbook.Saved = True
Application.Quit

End With
End Sub

There seems to be a bug with imsg. If you dont put text in the body of the email the attachments lose all formatting. The code below works.ChDir "c:\Temp1"
ActiveWorkbook.SaveCopyAs Filename:=Range("FF1").Text & " Closing Sheet" & ".xls"


Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "*****@Gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*****"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With


With iMsg
Set .Configuration = iConf
.To = "*****@Gmail.com;******@Bellsouth.net"
.CC = ""
.BCC = ""
.From = """*****"" <*******@gmail.com>"
.Subject = "Closing Numbers"
.TextBody = "Attached you will find the closing numbers from last night." & vbCrLf & _
"" & vbCrLf & _
"Thanks" & vbCrLf & _
"" & vbCrLf & _
"" & vbCrLf & _
"Management" & vbCrLf & _
"" & vbCrLf & _
"This is a auto generated email, please do not reply."
.AddAttachment "c:\Temp1\" & Range("FF1").Text & " Closing Sheet" & ".xls"
.send

Kill Range("FF1").Text & " Closing Sheet" & ".xls"


ActiveWorkbook.Saved = True
Application.Quit

End With
End Sub