Hi all,

I am trying desperately to do SMTP mail send and have never done it
before, im getting an automation error on the .send line and I dont
know anything about this

the code below: nothing matters except sending a sheet through email,
the only thing i need to know is how to make it work.

This code I think I got it from Ron or Chip I cant remember now, please
help make it work?

Private Sub CommandButton1_Click()

Dim iMsg As Object
Dim iConf As Object
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook

Sheets("Sheet3").Copy
'Other possibility's are
'ActiveSheet.Copy
'Sheets(Array("Sheet1", "Sheet3")).Copy

Set WB2 = ActiveWorkbook

' It will save the new file with the ActiveSheet in C:/ with a Date
and Time stamp
WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy
h-mm-ss") & ".xls"
WB2.SaveAs "C:/" & WBname
WB2.Close False

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/sendusing") = 2

..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"100.1.120.2"

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

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Me"" "
.Subject = "This is a test"
.TextBody = "Hi there"
'.AddAttachment "C:/" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
'Kill "C:/" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set WB1 = Nothing
Set WB2 = Nothing
Application.ScreenUpdating = True
End Sub


Many thanks in advance

Duncan

Me again,

I have got past the Automation Error, (put the code into a module and
not worksheet code) but now I have this error

"The message could not be sent to the SMTP server. The transport error
code was 0x800ccc15. The server response was not available"

Can anyone shed any light at all? or offer any tips?

Duncan




Duncan wrote:

Hi all,

I am trying desperately to do SMTP mail send and have never done it
before, im getting an automation error on the .send line and I dont
know anything about this

the code below: nothing matters except sending a sheet through email,
the only thing i need to know is how to make it work.

This code I think I got it from Ron or Chip I cant remember now, please
help make it work?

Private Sub CommandButton1_Click()

Dim iMsg As Object
Dim iConf As Object
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook

Sheets("Sheet3").Copy
'Other possibility's are
'ActiveSheet.Copy
'Sheets(Array("Sheet1", "Sheet3")).Copy

Set WB2 = ActiveWorkbook

' It will save the new file with the ActiveSheet in C:/ with a Date
and Time stamp
WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy
h-mm-ss") & ".xls"
WB2.SaveAs "C:/" & WBname
WB2.Close False

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/sendusing") = 2

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"100.1.120.2"

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

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Me"" "
.Subject = "This is a test"
.TextBody = "Hi there"
'.AddAttachment "C:/" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
'Kill "C:/" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set WB1 = Nothing
Set WB2 = Nothing
Application.ScreenUpdating = True
End Sub


Many thanks in advance

Duncan

check ron debruin's site

http://www.rondebruin.nl/sendmail.htm

--


Gary


"Duncan" wrote in message
ups.com...
Hi all,

I am trying desperately to do SMTP mail send and have never done it
before, im getting an automation error on the .send line and I dont
know anything about this

the code below: nothing matters except sending a sheet through email,
the only thing i need to know is how to make it work.

This code I think I got it from Ron or Chip I cant remember now, please
help make it work?

Private Sub CommandButton1_Click()

Dim iMsg As Object
Dim iConf As Object
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook

Sheets("Sheet3").Copy
'Other possibility's are
'ActiveSheet.Copy
'Sheets(Array("Sheet1", "Sheet3")).Copy

Set WB2 = ActiveWorkbook

' It will save the new file with the ActiveSheet in C:/ with a Date
and Time stamp
WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy
h-mm-ss") & ".xls"
WB2.SaveAs "C:/" & WBname
WB2.Close False

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/sendusing") = 2

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"100.1.120.2"

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

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Me"" "
.Subject = "This is a test"
.TextBody = "Hi there"
'.AddAttachment "C:/" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
'Kill "C:/" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set WB1 = Nothing
Set WB2 = Nothing
Application.ScreenUpdating = True
End Sub


Many thanks in advance

Duncan

Gary

Thank you

Duncan

Gary Keramidas wrote:

check ron debruin's site

http://www.rondebruin.nl/sendmail.htm

--


Gary


"Duncan" wrote in message
ups.com...
Hi all,

I am trying desperately to do SMTP mail send and have never done it
before, im getting an automation error on the .send line and I dont
know anything about this

the code below: nothing matters except sending a sheet through email,
the only thing i need to know is how to make it work.

This code I think I got it from Ron or Chip I cant remember now, please
help make it work?

Private Sub CommandButton1_Click()

Dim iMsg As Object
Dim iConf As Object
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook

Sheets("Sheet3").Copy
'Other possibility's are
'ActiveSheet.Copy
'Sheets(Array("Sheet1", "Sheet3")).Copy

Set WB2 = ActiveWorkbook

' It will save the new file with the ActiveSheet in C:/ with a Date
and Time stamp
WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy
h-mm-ss") & ".xls"
WB2.SaveAs "C:/" & WBname
WB2.Close False

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/sendusing") = 2

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"100.1.120.2"

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

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Me"" "
.Subject = "This is a test"
.TextBody = "Hi there"
'.AddAttachment "C:/" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
'Kill "C:/" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set WB1 = Nothing
Set WB2 = Nothing
Application.ScreenUpdating = True
End Sub


Many thanks in advance

Duncan