|
The sample code below provides the ability to create a COM-compliant or ActiveX style DLL for sending Email via SMTP from Microsoft Access or Visual Basic 5 or 6.
Option Explicit On
Option Strict On
Interface iSMTPSenderClass
Property SMTPServer() As String
Function SendEmail(ByRef FromAddress As RecipientType, _
ByRef Recipient As RecipientType(), _
Optional ByRef CC As RecipientType() = Nothing, _
Optional ByRef BCC As RecipientType() = Nothing, _
Optional ByVal Subject As String = "", _
Optional ByVal Body As String = "", _
Optional ByVal BodyIsHtml As Boolean = False, _
Optional ByRef Attachments() As AttachmentsType = Nothing) As Boolean
Function SendEmail(ByRef FromAddress As RecipientType, ByRef Recipient As RecipientType(), _
ByRef CC As RecipientType(), ByVal Subject As String, ByVal Body As String, _
ByVal BodyIsHtml As Boolean) As Boolean
Function SendEmail(ByRef FromAddress As RecipientType, ByRef Recipient As RecipientType(), _
ByRef CC As RecipientType(), ByVal Subject As String, ByVal Body As String, _
ByVal BodyIsHtml As Boolean, ByRef Attachments() As AttachmentsType) As Boolean
End Interface
<ComClass(SMTPSenderClass.ClassId, SMTPSenderClass.InterfaceId, SMTPSenderClass.EventsId)> _
Public Class SMTPSenderClass
Implements iSMTPSenderClass
Private pSMTPServer As String = ""
#Region "COM GUIDs"
' These GUIDs provide the COM identity for this class
' and its COM interfaces. If you change them, existing
' clients will no longer be able to access the class.
Public Const ClassId As String = "e64a0b9f-4f88-42fa-afc7-e588b395152e"
Public Const InterfaceId As String = "c9110397-b72b-4ae4-9da8-853ce3edb073"
Public Const EventsId As String = "7d6251f2-71a8-4f5f-aaee-84ef7e3c2a57"
#End Region
Public Property SMTPServer() As String Implements iSMTPSenderClass.SMTPServer
Get
Return pSMTPServer
End Get
Set(ByVal value As String)
pSMTPServer = value
End Set
End Property
Public Function SendEmail(ByRef FromAddress As RecipientType, _
ByRef Recipient As RecipientType(), _
Optional ByRef CC As RecipientType() = Nothing, _
Optional ByRef BCC As RecipientType() = Nothing, _
Optional ByVal Subject As String = "", _
Optional ByVal Body As String = "", _
Optional ByVal BodyIsHtml As Boolean = False, _
Optional ByRef Attachments() As AttachmentsType = Nothing) As Boolean _
Implements iSMTPSenderClass.SendEmail
Dim SM As System.Net.Mail.SmtpClient
Dim MSG As System.Net.Mail.MailMessage
Dim ATT As System.Net.Mail.Attachment
Dim a As Int32 = 0
If pSMTPServer <> "" Then
MSG = New System.Net.Mail.MailMessage
MSG.From = FromAddress.GetRecip
For a = LBound(Recipient) To UBound(Recipient)
MSG.To.Add(Recipient(a).GetRecip)
Next
If Not (CC Is Nothing) Then
For a = LBound(CC) To UBound(CC)
MSG.CC.Add(CC(a).GetRecip)
Next
End If
If Not (BCC Is Nothing) Then
For a = LBound(BCC) To UBound(BCC)
MSG.Bcc.Add(BCC(a).GetRecip)
Next
End If
MSG.IsBodyHtml = BodyIsHtml
MSG.Body = Body
MSG.Subject = Subject
If Not (Attachments Is Nothing) Then
For a = LBound(Attachments) To UBound(Attachments)
ATT = New System.Net.Mail.Attachment(Attachments(a).FileName)
MSG.Attachments.Add(ATT)
Next
End If
SM = New System.Net.Mail.SmtpClient
SM.Host = pSMTPServer
SM.Send(MSG)
Return True
Else
Err.Raise(vbObjectError + 513, "SMTPSenderClass.SendEmail", _
"No SMTP Server specified. Cannot send mail.")
Return False
End If
End Function
Public Function SendEmail(ByRef FromAddress As RecipientType, _
ByRef Recipient As RecipientType(), _
ByRef CC As RecipientType(), ByVal Subject As String, _
ByVal Body As String, ByVal BodyIsHtml As Boolean) As Boolean _
Implements iSMTPSenderClass.SendEmail
Dim SM As System.Net.Mail.SmtpClient
Dim MSG As System.Net.Mail.MailMessage
Dim a As Int32 = 0
If pSMTPServer <> "" Then
MSG = New System.Net.Mail.MailMessage
MSG.From = FromAddress.GetRecip
For a = LBound(Recipient) To UBound(Recipient)
MSG.To.Add(Recipient(a).GetRecip)
Next
If Not (CC Is Nothing) Then
For a = LBound(CC) To UBound(CC)
MSG.CC.Add(CC(a).GetRecip)
Next
End If
MSG.IsBodyHtml = BodyIsHtml
MSG.Body = Body
MSG.Subject = Subject
SM = New System.Net.Mail.SmtpClient
SM.Host = pSMTPServer
SM.Send(MSG)
Return True
Else
Err.Raise(vbObjectError + 513, "SMTPSenderClass.SendEmail", _
"No SMTP Server specified. Cannot send mail.")
Return False
End If
End Function
Public Function SendEmail(ByRef FromAddress As RecipientType, _
ByRef Recipient As RecipientType(), _
ByRef CC As RecipientType(), ByVal Subject As String, _
ByVal Body As String, ByVal BodyIsHtml As Boolean, _
ByRef Attachments() As AttachmentsType) As Boolean _
Implements iSMTPSenderClass.SendEmail
Dim SM As System.Net.Mail.SmtpClient
Dim MSG As System.Net.Mail.MailMessage
Dim ATT As System.Net.Mail.Attachment
Dim a As Int32 = 0
If pSMTPServer <> "" Then
MSG = New System.Net.Mail.MailMessage
MSG.From = FromAddress.GetRecip
For a = LBound(Recipient) To UBound(Recipient)
MSG.To.Add(Recipient(a).GetRecip)
Next
If Not (CC Is Nothing) Then
For a = LBound(CC) To UBound(CC)
MSG.CC.Add(CC(a).GetRecip)
Next
End If
For a = LBound(Attachments) To UBound(Attachments)
ATT = New System.Net.Mail.Attachment(Attachments(a).FileName)
MSG.Attachments.Add(ATT)
Next
MSG.IsBodyHtml = BodyIsHtml
MSG.Body = Body
MSG.Subject = Subject
SM = New System.Net.Mail.SmtpClient
SM.Host = pSMTPServer
SM.Send(MSG)
Return True
Else
Err.Raise(vbObjectError + 513, "SMTPSenderClass.SendEmail", _
"No SMTP Server specified. Cannot send mail.")
Return False
End If
End Function
End Class
Interface iRecipientType
Sub Address(ByVal RecipientEmailAddress As String, Optional ByVal RecipientName As String = "")
End Interface
<ComClass(RecipientType.ClassId, RecipientType.InterfaceId, RecipientType.EventsId)> _
Public Class RecipientType
Implements iRecipientType
Private pMA As System.Net.Mail.MailAddress
#Region "COM GUIDs"
' These GUIDs provide the COM identity for this class
' and its COM interfaces. If you change them, existing
' clients will no longer be able to access the class.
Public Const ClassId As String = "03973e44-6bf3-4752-a7b3-b41839bf7ad4"
Public Const InterfaceId As String = "9d707fb6-556e-4de6-92f8-58716e068fef"
Public Const EventsId As String = "ed7f1001-3750-4731-b131-67af243a6c09"
#End Region
Public Sub Address(ByVal RecipientEmailAddress As String, _
Optional ByVal RecipientName As String = "") _
Implements iRecipientType.Address
If RecipientName <> "" Then
pMA = New System.Net.Mail.MailAddress(RecipientEmailAddress, RecipientName)
Else
pMA = New System.Net.Mail.MailAddress(RecipientEmailAddress)
End If
End Sub
Friend Function GetRecip() As System.Net.Mail.MailAddress
Return pMA
End Function
End Class
Interface iAttachementsType
Property FileName() As String
End Interface
<ComClass(AttachmentsType.ClassId, AttachmentsType.InterfaceId, AttachmentsType.EventsId)> _
Public Class AttachmentsType
Implements iAttachementsType
Private pFileName As String
#Region "COM GUIDs"
' These GUIDs provide the COM identity for this class
' and its COM interfaces. If you change them, existing
' clients will no longer be able to access the class.
Public Const ClassId As String = "6e91c040-2732-4338-9326-002e723891bd"
Public Const InterfaceId As String = "619ccf5d-eb99-4aef-b78a-4239bc13a6d6"
Public Const EventsId As String = "7e5435b8-97c5-4e71-b726-65fa7adc883e"
#End Region
Public Property FileName() As String Implements iAttachementsType.FileName
Get
Return pFileName
End Get
Set(ByVal value As String)
If Dir(value) <> "" Then
pFileName = value
Else
pFileName = Nothing
End If
End Set
End Property
End Class
Create a Class Library Project using VB.Net 2008. Add the code above to the project. Open the Project Properties dialog box. From the 'Application' tab, select the option under 'Assembly Information' called 'Make Assembly COM Visible'. Choose the 'Compile' Tab. At the bottom of the tab there is an option called 'Register for COM Interop'; place a checkmark beside this option. Build your project. Open your Access 2000/2003/2007 MDB file, open a code window, add a reference to your SMTP DLL, then press 'F2' to view the SMTP properties inside the Object Browser. You should have no problem using this DLL as it is nice and simple with only 4 possible functions, all of which are very self explanatory.
By downloading, copying, or using this code, you agree to use it solely at your own risk. I provide no warranty express or implied for this code.
I can be reached via email to mvernon@mvct.ca. If I don't reply it's because either my spam filter took care of you, or I'm really busy. Either way, please accept my apologies in advance.
|
