Public Function Send_Email(ByVal TO_Email_Address As String, ByVal CC_Email_Address As String, ByVal FROM_Email_Address As String, ByVal FROM_DisplayName As String, ByVal REPLYTOLIST_Email_Address As String, ByVal Attach_File As String, ByVal Password As String, ByVal SMTP_Server_Address As String, ByVal Port As String, ByVal EnableSSL As Boolean, ByVal Subject_Title As String, ByVal Text_Body As String, Optional ByVal Attachements_Path As String = "") As Boolean
'-------------------------------<
Send_Email() >-------------------------------
'--<
Variablen >--
Dim Result_Send As Boolean = False
'--</
Variablen >--
'-<
check >-
If TO_Email_Address Like "" Then
MsgBox("Email Adress TO is empty", MsgBoxStyle.Critical, "Send_Email")
Return False
Exit Function
End If
If FROM_Email_Address Like "" Then
MsgBox("Email Adress FROM is empty", MsgBoxStyle.Critical, "Send_Email")
Return False
Exit Function
End If
'-</
check >-
Dim arrEmpfaenger As Array
arrEmpfaenger = Split(TO_Email_Address, ";", , CompareMethod.Binary)
If arrEmpfaenger.Length > 1 Then
TO_Email_Address =
arrEmpfaenger(0)
End If
'----<
Email >----
Try
'---< Mailobjekt erzeugen und senden
>--
If FROM_DisplayName Like "" Then
FROM_DisplayName =
FROM_Email_Address
End If
Dim MailAdress_From As New MailAddress(FROM_Email_Address,
FROM_DisplayName)
Dim MailAdress_To As New
System.Net.Mail.MailAddress(TO_Email_Address)
Dim email_Message As New
System.Net.Mail.MailMessage(MailAdress_From, MailAdress_To)
'--< add multi addresses >--
'< TO >
If arrEmpfaenger.Length > 1 Then
For iAn As Integer = 1 To arrEmpfaenger.Length - 1
email_Message.To.Add(arrEmpfaenger(iAn))
Next
End If
'</ TO >
'< CC >
If Not CC_Email_Address Like "" Then
Dim arrCC As Array
arrCC =
Split(CC_Email_Address, ";", , CompareMethod.Binary)
For iCC As Integer = 0 To arrCC.Length - 1
email_Message.CC.Add(arrCC(iCC))
Next
End If
'</ CC >
'< ReplyToList >
'*ReplyTo is obsolete
If Not REPLYTOLIST_Email_Address Like "" Then
Dim arrReplyToList As Array
arrReplyToList =
Split(REPLYTOLIST_Email_Address, ";", , CompareMethod.Binary)
For iReplyTo As Integer = 0 To arrReplyToList.Length - 1
email_Message.ReplyToList.Add(arrReplyToList(iReplyTo))
Next
End If
'</ ReplyToList >
'--</ add multi addresses >--
'--< Attach a File >--
'*add a File to email
'*Imports System.Net.Mail and
System.Net.Mime
If Not (Attach_File = "") Then
Dim attachment As Attachment = New Attachment(Attach_File,
MediaTypeNames.Application.Octet)
email_Message.Attachments.Add(attachment)
End If
'--</ Attach a File >--
email_Message.IsBodyHtml = True
email_Message.Subject =
Subject_Title
email_Message.Body = Text_Body
'----< Mailobject >----
Dim email_SmtpClient As New SmtpClient(SMTP_Server_Address) 'System.Net.Mail.
email_SmtpClient.UseDefaultCredentials = False '*either windows login or
user-password
email_SmtpClient.EnableSsl =
EnableSSL
email_SmtpClient.Port = Port
email_SmtpClient.DeliveryMethod =
SmtpDeliveryMethod.Network 'System.Net.Mail.
email_SmtpClient.Credentials = New
Net.NetworkCredential(FROM_Email_Address, Password)
email_SmtpClient.Timeout = 60000
'--< Try: Send Mail >--
Try
'< send >
email_SmtpClient.Send(email_Message)
email_SmtpClient.Dispose()
'</ send >
'Status_Text = "status=OK /send
to:" & TO_Email_Address & " subject:" &
Subject_Title
Result_Send = True
Catch ex As Exception
'-< Fehler >-
Dim sError As String
If ex.InnerException Is Nothing Then
sError = ex.Message
Else
sError = ex.Message &
vbCrLf & ex.InnerException.Message
End If
MsgBox(sError)
'-</ Fehler >-
End Try
'--</ Try: Send Mail >--
'---</
Mailobjekt erzeugen und senden >--
Catch ex As Exception
'-< Fehler >-
Dim sError As String
If ex.InnerException Is Nothing Then
sError = ex.Message
Else
sError = ex.Message &
vbCrLf & ex.InnerException.Message
End If
MsgBox(sError)
'-</ Fehler >-
End Try
'----<
Mailobject >----
'<
Abschluss >
Return Result_Send
'</
Abschluss >
'----</
Email >----
'-------------------------------< Send_Email()
>-------------------------------
End Function
|