fniles said:
Thank you all for the replies.
This is a different project than the other posting that I posted.
The same problem happened on both VB6 and VB.NET program.
Unfortunately, we can only use MS objects, not 3rd party.
Then I even more strongly suggest that you consider using CDO. Here's the
function I use. You'll obviously need/want to make some changes to the
code. For example, you may not want to store the settings (smtp server name,
credentials, etc.) in an INI file as I have. You may want to store them in
a database or whatever. You may also not want to verify that a file for
attachment actually exists (if you do, you can just write your own
FileExists function).
The email body, recipient list, and file attachments (can be a string or any
array of strings) get passed to the function. You do not need to specify
any references in VB's References dialog box. The code uses late-binding
for the CDO objects. If you want to use early-binding, however, you could.
I've provided the CDO objects you'd use as comments in the variable
declarations. If you use early-binding, comment out the 2 cdo<x> constants
(the constants, NOT the variables).
This code also represents one of the very FEW times that I'll ever use a
Variant data type. For this function and purpose, it just makes sense though
because it allows for either a single string or an array to be passed for
the file(s) to be attached to the email. Also note that it's an optional
parameter.
-----BEGIN CODE
Public Function SendMailSMTP(ByVal EmailBody As String, ByVal sMailTo As
String, Optional varFileAttachment As Variant) As Boolean
Dim sErrMsg As String
Dim sMailFrom As String
Dim sSMTPServer As String
Dim sSubject As String
Dim sUser As String
Dim sPassword As String
Dim cdoConfig As Object 'CDO.Configuration
Dim cdoMessage As Object 'CDO.Message
Dim sBuffer As String
Dim lBuffer As Long
Dim Index As Long
Const SCHEMA As String =
"
http://schemas.microsoft.com/cdo/configuration/"
Const cdoSendUsingPort As Long = 2
Const cdoBasic As Long = 1
On Error GoTo EH
lBuffer = 255
'Read email settings from INI file
If Len(Trim$(sMailTo)) = 0 Then
'Only read TO recipients if not passed in
sBuffer = String$(lBuffer, vbNullChar)
Call GetPrivateProfileString("Email", "To", "", sBuffer, lBuffer,
INIFile)
sMailTo = StripNulls(sBuffer)
End If
sBuffer = String$(lBuffer, vbNullChar)
Call GetPrivateProfileString("Email", "From", "Administrator", sBuffer,
lBuffer, INIFile)
sMailFrom = StripNulls(sBuffer)
sBuffer = String$(lBuffer, vbNullChar)
Call GetPrivateProfileString("Email", "SMTPServer", "", sBuffer,
lBuffer, INIFile)
sSMTPServer = StripNulls(sBuffer)
sBuffer = String$(lBuffer, vbNullChar)
GetPrivateProfileString "Email", "UserName", "", sBuffer, lBuffer,
INIFile
sUser = SimpleEncrypt(StripNulls(sBuffer), False)
sBuffer = String$(lBuffer, vbNullChar)
GetPrivateProfileString "Email", "Password", "", sBuffer, lBuffer,
INIFile
sPassword = SimpleEncrypt(StripNulls(sBuffer), False)
sBuffer = String$(lBuffer, vbNullChar)
Call GetPrivateProfileString("Email", "Subject", "SOP Import Error Log",
sBuffer, lBuffer, INIFile)
sSubject = StripNulls(sBuffer)
If (Len(sMailTo) > 0) And (Len(sMailFrom) > 0) And (Len(sSMTPServer) >
0) Then
Set cdoMessage = CreateObject("CDO.Message")
'Create CDO Configuration
Set cdoConfig = CreateObject("CDO.Configuration")
cdoConfig.Fields.Item(SCHEMA & "sendusing") = cdoSendUsingPort
cdoConfig.Fields.Item(SCHEMA & "smtpserver") = sSMTPServer
If Len(sUser) Then
cdoConfig.Fields.Item(SCHEMA & "smtpauthenticate") = cdoBasic
cdoConfig.Fields.Item(SCHEMA & "sendusername") = sUser
cdoConfig.Fields.Item(SCHEMA & "sendpassword") = sPassword
End If
cdoConfig.Fields.Update
With cdoMessage
Set .Configuration = cdoConfig
.To = sMailTo
.From = sMailFrom
.Subject = sSubject
.AutoGenerateTextBody = True
'.TextBody = EmailBody
.HTMLBody = Replace$(EmailBody, vbCrLf, "<BR>")
If Not IsMissing(varFileAttachment) Then
If IsArray(varFileAttachment) Then
For Index = LBound(varFileAttachment) To
UBound(varFileAttachment)
If FileExists(varFileAttachment(Index)) Then
.AddAttachment varFileAttachment(Index)
End If
Next
Else
If FileExists(varFileAttachment) Then
.AddAttachment varFileAttachment
End If
End If
End If
.Send
SendMailSMTP = True
End With
End If
Screen.MousePointer = vbDefault
Exit Function
EH:
Screen.MousePointer = vbDefault
sErrMsg = "The following error was raised in procedure SendMailSMTP." &
vbCrLf & vbCrLf
sErrMsg = sErrMsg & "Error Number: " & Err.Number & vbCrLf
sErrMsg = sErrMsg & "Source: " & Err.Source & vbCrLf
sErrMsg = sErrMsg & "Error Message: " & Err.Description
#If SERVICE = 1 Then
Forms(0).NTS.LogEvent svcEventError, svcMessageError,
"WEBORDER_IMPORT: " & sErrMsg
#Else
MsgBox sErrMsg, vbCritical, App.Title
#End If
SendMailSMTP = False
End Function
-----END CODE
Perhaps this one function can solve all your email problems that you've
lately been posting.
