ActiveX COM Control: Email Client für Office Anwendungen

Date 22.11.2017

Dieses Codebeispiel enthält den Code zum erstellen einer eigenständigen ActiveX Komponente und zeigt weiter unten die Einbettung in Microsof MS Access.

Vb.net, 4.6

Ein ActiveX COM Control, welches einen MailClient für Office und andere Anwendungen bietet.

Das COM Control ist in Vb.net im Framework 4.6 geschrieben und hat somit vollen Zugriff auf die .Net Framework Welt.

Vb.net Code

Imports System.Net.Mail

Imports System.Net.Mime

Imports System.Runtime.InteropServices

<ComClass(axEmail_Send.ClassId, axEmail_Send.InterfaceId, axEmail_Send.EventsId)>

<ComVisible(True)>

Public Class axEmail_Send

'-------------------------------< Class: Email_Sender >-------------------

'--< IDs GUID >--

Public Const ClassId As String = "11111111 yourGuid"

Public Const InterfaceId As String = "222222 yourGuid "

Public Const EventsId As String = "3333333 yourGuid "

'--</ IDs GUID >--

Public Status_Text As String = ""

'--------------< Class: Init >--------------

Public Sub New()

MyBase.New()

End Sub

'--------------</ Class: Init >--------------

#Region "Functions"

'-------------------------< Region: Functions >------------------

Public Function Send_Email(ByVal TO_Email_Address As String, ByVal CC_Email_Address As String, ByVal FROM_Email_Address 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 >--

Dim MailAdress_From As New System.Net.Mail.MailAddress(FROM_Email_Address)

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))

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))

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))

End If

'</ ReplyToList >

'--</ add multi addresses >--

'--< Attach a File >--

'*add a File to email

'*Imports System.Net.Mail and System.Net.Mime

If (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 = 20000

'--< 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

'-------------------------</ Region: Functions >------------------

#End Region

'-------------------------------</ Class: Email_Sender >-------------------

End Class

Unter MS Access oder MS Excel kann man die Komponente im Hintergrund einbetten und als vba Code ansprechen.

Hierzu muss man aber unter der Visual Basic Code Umgebung mit Alt+F11 einen Verweis auf die Komponente einrichten

Menü->Extras->Veweise

To use under the Office applications, you must first install the COM component as an admitrator by executing the file register_axEmail_Send.

In der register.bat Datei steht die Anweisung für regasm, welcher die COM ActiveX Komponente in die Windows 10 Registry einträgt und dabei auch noch die .tlb Schnittstellendatei erstellt.

C:\Windows\Microsoft.NET\Framework\v4.0.30319\regasm.exe "C:\_Daten\Desktop\Demo\Access\2017-11-22 AxEmail Send\axEmail_Send.dll" /tlb /codebase

pause

Anbei das komplette Beispiel für eine Access Anwendung.

Option Compare Database

Option Explicit On

Private Sub btnSend_Click()

'---------------< btnSend_Click() >----------------

fx_Email_Senden()

'---------------</ btnSend_Click() >----------------

End Sub

Private Sub fx_Email_Senden()

'-------------< fx_Email_Senden() >-------------

'--< Email einstellen >--

Dim objEmail As axEmail_Send.axEmail_Send

Set objEmail = New axEmail_Send.axEmail_Send

Dim sAddress_TO As String, sAddress_CC As String, sSubject As String, sText As String

Dim sAddress_REPLYTO As String, sAttach_File As String

Dim sAddress_FROM As String, sPassword As String, SMTP_Address As String, sPort As String, Enable_SSL As Boolean

sAddress_FROM = tbxEmail_From

sPassword = tbxPassword

SMTP_Address = tbxDomain

sAddress_TO = tbxEmail_To

sAddress_CC = tbxEmail_Cc

sAddress_REPLYTO = tbxReplyTo

sAttach_File = tbxAttach_File

Enable_SSL = True

sPort = tbxPort

sSubject = tbx_Subject

sText = tbxText

'< SEND >

'*send with axEmail_Send.dll Control

objEmail.Send_Email sAddress_TO, sAddress_CC, sAddress_FROM, sAddress_REPLYTO, sAttach_File, sPassword, SMTP_Address, sPort, Enable_SSL, sSubject, sText

'</ SEND >

'--< Email einstellen >--

'< Abschluss >

Set objEmail = Nothing

'</ Abschluss >

MsgBox "fertig"

'----</ mit Outlook senden >----

'-------------</ fx_Email_Senden() >-------------

End Sub

Appendix: ActiveX Component and Example in Access Database