D
Duncan
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 = "(e-mail address removed)"
.CC = ""
.BCC = ""
.From = """Me"" <[email protected]>"
.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
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 = "(e-mail address removed)"
.CC = ""
.BCC = ""
.From = """Me"" <[email protected]>"
.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