سلام
قبلا ارسال ایمیل با این کد تو vb6 انجام میشد.الان ارور میده .مشکلش کجاس؟
Public Function SendMail(ByVal sMailSender As String, _
ByVal sMailSenderPassword As String, _
ByVal sMailSubject As String, _
ByVal sMailReciever As String, _
ByVal sMailText As String, _
Optional ByVal sMailAttachFile As String) As String
On Error GoTo EndLine
Dim obMsg As Object
Dim obConf As Object
Dim Flds As Object
Dim strSchema As String
If sMailSender = vbNullString Or sMailSenderPassword = vbNullString Then
Err.Description = "Mail Sender or Password is Blank!"
GoTo EndLine
End If
Set obMsg = CreateObject("CDO.Message")
Set obConf = CreateObject("CDO.Configuration")
Set Flds = obConf.Fields
' send one copy with Google SMTP server (with autentication)
strSchema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(strSchema & "sendusing") = 2
Flds.Item(strSchema & "smtpserver") = "smtp." & Mid$(sMailSender, 1 + InStr(1, sMailSender, "@"))
If LCase(Mid$(sMailSender, 1 + InStr(1, sMailSender, "@"))) = "yahoo.com" Then
Flds.Item(strSchema & "smtpserver") = "smtp.mail.yahoo.co.uk"
End If
Flds.Item(strSchema & "smtpserverport") = 465
Flds.Item(strSchema & "smtpauthenticate") = 1
Flds.Item(strSchema & "sendusername") = sMailSender
Flds.Item(strSchema & "sendpassword") = sMailSenderPassword
Flds.Item(strSchema & "smtpusessl") = 1
Flds.Item(strSchema & "cdoSMTPConnectionTimeout") = 5
Flds.Update
With obMsg
.To = sMailReciever
.From = sMailSender
.Subject = sMailSubject
.htmlbody = "<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"">" & sMailText
' .TextBody = sMailText
.BodyPart.Charset = "utf-8"
.TextBodyPart.Charset = "utf-8"
.HTMLBodyPart.Charset = "utf-8"
' .Sender = sMailSender
' .Organization = "S.M.B Productions"
.ReplyTo = sMailSender
If sMailAttachFile <> vbNullString Then
.AddAttachment (sMailAttachFile)
End If
Set .Configuration = obConf
.Send
End With
SendMail = "Message Sent!"
Set obMsg = Nothing
Set obConf = Nothing
Set Flds = Nothing
Exit Function
EndLine:
Set obMsg = Nothing
Set obConf = Nothing
Set Flds = Nothing
SendMail = Err.Description
End Function