Send attachment via CDO

[LeAnn]

Hi,

I have followed Ron's instructions from http://www.rondebruin.nl/cdo.htm and
I am not getting any emails. A few things I know:

I am able to send .csv & .xls as attachments through our firewall.
The copy doesn't contain any VBA code so the firewall isn't blocking it.
I am able to manually email as an attachment, the orignally saved file.
Yes my email account is setup.
I receive no errors and the code appears to work as expected.

I even tried the simple text example on Ron's page and never got the email.
My code is below. Can anyone see a problem with it or suggest some
investigative actions I should take? I'm not sure how to "Check your
firewall settings".

Thanks
LeAnn

Sub Button1_Click()
Dim strUnit As String
Dim strFname As String

Worksheets(1).Activate
Range("A2").Select
strUnit = ActiveCell.Value
strFname = Worksheets("Parameters").Range("B1").Value & Format(Now(),
"mmddyyyyhhnn") & ".csv"

Do Until strUnit = ""
If Left(strUnit, 1) = "=" Then
strUnit = Mid(strUnit, 2, 15)
ActiveCell.Value = strUnit
End If
ActiveCell.Value = UCase(strUnit)
ActiveCell.Offset(1, 0).Select
strUnit = ActiveCell.Value
Loop
ActiveWorkbook.SaveAs strFname, xlCSV

Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
' Dim Flds As Variant

Set wb = ActiveWorkbook

If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no
VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = wb.Name

wb.SaveCopyAs TempFilePath & TempFileName

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") = "Fill in
your SMTP server here"
'
..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 = """Center XXX"" <someone@somewhere>"
.Subject = "List"
.TextBody = ""
.AddAttachment TempFilePath & TempFileName
.Send
End With

'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName

With Application
.ScreenUpdating = True
.EnableEvents = True
End With


Application.DisplayAlerts = False
Application.Quit
End Sub

 

[Ron de Bruin]

Hi LeAnn

Can you try to mail to another mail account

Good night

 

[LeAnn]

I will try that. But, I just got a shock -- I received 4 emails just now
from yesterday's attempts. That only took about 24 hours!! Why would it
take that long? Any ideas?

Thanks
LeAnn

 

[Ron de Bruin]

Hi LeAnn

Maybe your provider filter the mail that go out from the smtp server.

Do you have a gmail account ?
If you do try to use the gmail smtp server in the example download and see if this is faster

 

[LeAnn]

No, I don't have a gmail account. I did try your suggestion and had it go to
a co-worker. He recieved the email within 10 minutes or so. Much more
reasonable. I'll continue testing but I think it will be ok.

Thanks for your help.