NEED HELP - Auto Email file from diff locations, I donno server na

[Sriram]

Dear Friends,

I've done a very extensive excel project for my official use with the help
of some excel gurus over here.

Now as the last and final touch of my project, I have a code which will not
use MS Outlook or any other email clients and automatically email the file to
me when the user close, without the knowledge of the user.

It is working good in my office environment, but when I tested this from
other states (our project is extended in all over our country), where some of
our employees are in our client's place, they are getting an error at the
time they close the file.

Below is the error, they are getting.

Run-time error '-2142220973 (80040213)':

The transport failed to connect to the server.

And the dialog bx is having the only option of "End" the program, and the
file is not getting mailed to me automatically. (But if I'm working on that,
the line where I mentioend .Send, is highlighted for error.)

This I can somewhat find out what may the problem. This is because of the
server name which is not available or unable to find in the environment.

Actually what I want is that, because the code I used, will get the server
name and send the file automatically using it. And because the server will be
different in some locations of our office, I want a code which will work in
any server environment or a code to find out the server name which is in the
environment. (I hope the later can be achieved).

Please have a look at my code and suggest me some solution to get rid of
this eror.

---- Code Begins



Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call CDO_Send_Workbook

End Sub


' Auto Mailing with CDO - Code Begins

Sub CDO_Send_Workbook()
Dim iMsg As Object
Dim iConf As Object
Dim wb As Workbook
Dim WBname As String
Dim User As String
Dim Flds As Variant

User = Environ("UserName")

Select Case (User)
Case "sra016", "vpu001", "sob001":
'DO NOTHING
Case Else:
Application.ScreenUpdating = False
Set wb = ActiveWorkbook

' It will save a copy of the file in C:/ with a Date and Time
stamp
WBname = Sheet1.Cells(2, 3).Value & "-" & wb.Name & " " &
Format(Now, "dd-mm-yy hh-mm-ss") & ".xls"
wb.SaveCopyAs "C:/" & WBname

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") =
"upw.ttsl.com"

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

With iMsg
Set .Configuration = iConf
.To = "(e-mail address removed)"
.CC =
"(e-mail address removed),[email protected],[email protected]"
.BCC = ""
.From = "" & Sheet1.Cells(2, 3).Value
.Subject = Sheet1.Cells(2, 3).Value & "-QA Visit Schedule as
of " & Now
.TextBody = "Please find enclosed the QA Site Visit
Schedule, which is Auto Mailed to you." & vbNewLine & vbNewLine & vbNewLine &
"From Circle: " & Sheet1.Cells(2, 3).Value & vbNewLine & vbNewLine &
vbNewLine & "This is auto generated mail. So don't reply." & vbNewLine &
vbNewLine
.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 wb = Nothing
Application.ScreenUpdating = True
End Select

End Sub

' Auto Mailing with CDO - Code Ends


---- Code Ends

After AddAttachment in the line ".Send" I'm getting the highlighted at the
time of error.

Thanks
Sriram

 

[Ron de Bruin]

Hi Sriram

Check out Randy Site for code to get the SMTP server for OE or Outlook
http://vbnet.mvps.org/