Jim Dettman
jimdettman at verizon.net
Tue Dec 30 14:20:11 CST 2008
It is a .DLL, but it does not need to be registered. Just placed in the
same directory as the DB. It does need a reference set in code however, so
if you change install directories, that will be a problem. If so, I would
place it in something like \Windows\System32
Here's the URL for it:
http://www.freevbcode.com/ShowCode.Asp?ID=109
Below is the wrapper I wrote for it.
Jim.
Option Compare Database
Option Explicit
Const ModuleName = "clsOCS_SendMail"
' Wrapper class for vbSendMail, which provides a simplified
' interface for sending e-mail from a application.
'
' Most of the properties for vbSendMail are set via
' a call to .SetParams(), which reads table tblemailtemplates in the SYS
database.
' Notes:
' 1. Send() is the only method that returns a status. Other methods
failing
' will cause the send() method to fail.
'
' 2. SetParams() must be called first in order to send an e-mail message.
'
' 3. Once a Send() is attempted, you must call SetParams() again and
' set any other parameters before trying to send again.
'
' Example of use:
' Dim oSendMail As New OCS_SendMail
'
' oSendMail.SetParams("Test", ".", ".") ' Set default parameters via
template
' oSendMail.ShowStatus = True ' Tells send mail to display
progress form.
' varRet = oSendMail.Send ' Send the e-mail.
'
' If varRet = Null then
' Msgbox "Mail Sent"
' Else
' MsgBox "Main Send Failed"
' End If
Private WithEvents oVBSendMail As vbSendMail.clsSendMail
Public Enum MAIL_PRIORITY
HIGH_PRIORITY = 1
NORMAL_PRIORITY = 3
LOW_PRIORITY = 5
End Enum
Private bShowStatus As Boolean
Private bSetParamsCalled As Boolean
Private varErrorMessage As Variant
Public Property Get Attachment() As String
10 Attachment = oVBSendMail.Attachment
End Property
Public Property Let Attachment(ByVal strNewValue As String)
10 oVBSendMail.Attachment = strNewValue
End Property
Public Property Get AsHTML() As Boolean
10 AsHTML = oVBSendMail.AsHTML
End Property
Public Property Let AsHTML(ByVal bNewValue As Boolean)
10 On Error Resume Next
20 oVBSendMail.AsHTML = bNewValue
End Property
Public Property Get Message() As String
10 Message = oVBSendMail.Message
End Property
Public Property Let Message(ByVal strNewValue As String)
10 oVBSendMail.Message = strNewValue
End Property
Public Property Get Priority() As MAIL_PRIORITY
10 Priority = oVBSendMail.Priority
End Property
Public Property Let Priority(ByVal NewValue As MAIL_PRIORITY)
10 On Error Resume Next
20 oVBSendMail.Priority = NewValue
End Property
Public Property Get Recipient() As String
10 Recipient = oVBSendMail.Recipient
End Property
Public Property Let Recipient(ByVal strNewValue As String)
10 oVBSendMail.Recipient = strNewValue
End Property
Public Property Get RecipientDisplayName() As String
10 RecipientDisplayName = oVBSendMail.RecipientDisplayName
End Property
Public Property Let RecipientDisplayName(ByVal strNewValue As String)
10 oVBSendMail.RecipientDisplayName = strNewValue
End Property
Public Property Get ShowStatus() As Boolean
10 ShowStatus = bShowStatus
End Property
Public Property Let ShowStatus(ByVal bNewValue As Boolean)
10 On Error Resume Next
20 bShowStatus = bNewValue
30 Forms![frmSendMailStatus].Visible = bShowStatus
End Property
Public Property Get Subject() As String
10 Subject = oVBSendMail.Subject
End Property
Public Property Let Subject(ByVal strNewValue As String)
10 oVBSendMail.Subject = strNewValue
End Property
Private Sub Class_Initialize()
Const RoutineName = "Class_Initialize"
Const Version = "1.0.0"
10 On Error Resume Next
20 bShowStatus = False
30 DoCmd.OpenForm "frmSendMailStatus", acNormal, , , acFormEdit,
acHidden
40 bSetParamsCalled = False
50 varErrorMessage = Null
End Sub
Private Sub Class_Terminate()
Const RoutineName = "Class_Terminate"
Const Version = "1.0.0"
10 On Error Resume Next
20 DoCmd.Close acForm, "frmSendMailStatus"
End Sub
Public Function Send() As Variant
Const RoutineName = "Send"
Const Version = "1.0.0"
10 On Error GoTo Send_Err
' If SetParams called, then try sending message.
20 If IsNull(varErrorMessage) Then
30 If bSetParamsCalled = True Then
40 DoCmd.Hourglass True
50 oVBSendMail.Send
60 Else
70 varErrorMessage = "OCS Send Mail Failure - Send Called without
prior call to SetParams"
80 End If
90 End If
Send_Exit:
100 Send = varErrorMessage
110 Exit Function
Send_Err:
120 varErrorMessage = "Unexpected Error in OCS_SENDMAIL::SEND - Error: "
& Err.Number & " - " & Err.Description
130 Resume Send_Exit
End Function
Public Sub SetParams(strReference As String, strCompany As String,
strLocation As String)
Const RoutineName = "SetParams"
Const Version = "1.0.0"
10 On Error GoTo SetParams_Err
' Get an instance of vbSendMail
20 Set oVBSendMail = New clsSendMail
' Set parameters for e-mail based on template record.
Dim dbCur As DAO.Database
Dim rstemailtemplates As DAO.Recordset
Dim qdfPassthrough As DAO.QueryDef
' Find parameter record in tblemailtemplates
30 Set dbCur = CurrentDb()
40 Set qdfPassthrough = dbCur.CreateQueryDef("")
50 qdfPassthrough.Connect =
dbCur.TableDefs("tblemailtemplates").Connect
60 qdfPassthrough.sql = "Select * From tblemailtemplates WHERE
Reference = '" & strReference & "' AND Company = '" & strCompany & "' AND
Location = '" & strLocation & "'"
70 Set rstemailtemplates = qdfPassthrough.OpenRecordset()
80 If rstemailtemplates.RecordCount = 0 Then
90 varErrorMessage = "OCS_SENDMAIL::SETPARAMS - Error: Template for
company " & strCompany & " template name " & strReference & " not found."
100 Else
' Now Set parameters
110 With oVBSendMail
120 .UserName = Nz(rstemailtemplates![UserName], "")
130 .Password = Nz(rstemailtemplates![Password], "")
140 .POP3Host = Nz(rstemailtemplates![POP3Host], "")
150 .SMTPHost = Nz(rstemailtemplates![SMTPHost], "")
160 .from = Nz(rstemailtemplates![FromLine], "")
170 .FromDisplayName = Nz(rstemailtemplates![FromDisplayName], "")
180 .Recipient = Nz(rstemailtemplates![ToLine], "")
190 .RecipientDisplayName = Nz(rstemailtemplates![ToDisplayName],
"")
200 .CcRecipient = Nz(rstemailtemplates![ccLine], "")
210 .CcDisplayName = Nz(rstemailtemplates![CcDisplayName], "")
220 .BccRecipient = Nz(rstemailtemplates![bccLine], "")
230 .ReplyToAddress = Nz(rstemailtemplates![ReplyToAddress], "")
240 .Subject = Nz(rstemailtemplates![Subject], "") & " - " &
Format$(Now(), "mm/dd/yy hh:mm ampm") & " (local)"
250 .Message = Nz(rstemailtemplates![Message], "")
260 .AsHTML = rstemailtemplates![HTMLFormat]
270 .ContentBase = rstemailtemplates![ContentBase]
280 .EncodeType = rstemailtemplates![EncodeType]
290 .Priority = rstemailtemplates![Priority]
300 .Receipt = rstemailtemplates![Receipt]
310 .UseAuthentication = rstemailtemplates![UseAuthentication]
320 .UsePopAuthentication = rstemailtemplates![UsePopAuthentication]
330 .ConnectTimeout = rstemailtemplates![ConnectTimeout]
340 .ConnectRetry = rstemailtemplates![ConnectRetry]
350 .MessageTimeout = rstemailtemplates![MessageTimeout]
360 .SMTPPort = rstemailtemplates![SMTPPort]
370 .PersistentSettings = False
380 End With
390 bSetParamsCalled = True
400 End If
SetParams_Exit:
410 On Error Resume Next
420 rstemailtemplates.Close
430 Set rstemailtemplates = Nothing
440 qdfPassthrough.Close
450 Set qdfPassthrough = Nothing
460 Set dbCur = Nothing
470 Exit Sub
SetParams_Err:
480 varErrorMessage = "Unexpected Error in OCS_SENDMAIL::SETPARAMS -
Error: " & Err.Number & " - " & Err.Description
490 Resume SetParams_Exit
End Sub
Private Sub oVBSendMail_Status(Status As String)
Const RoutineName = "Status"
Const Version = "1.0.0"
10 On Error GoTo Status_Err
20 Forms![frmSendMailStatus]![txtStatus] = Status &
IIf(Len(Trim(Forms![frmSendMailStatus]![txtStatus])) > 0, vbCrLf &
Forms![frmSendMailStatus]![txtStatus], "")
Status_Exit:
30 Exit Sub
Status_Err:
40 varErrorMessage = "Unexpected Error in OCS_SENDMAIL::STATUS - Error:
" & Err.Number & " - " & Err.Description
50 Resume Status_Exit
End Sub
Private Sub oVBSendMail_Progress(lngPercentComplete As Long)
Const RoutineName = "Progress"
Const Version = "1.0.0"
10 On Error GoTo Progress_Err
20 Forms![frmSendMailStatus]![lblProgress].Caption = lngPercentComplete
& "% complete"
Progress_Exit:
30 Exit Sub
Progress_Err:
40 varErrorMessage = "Unexpected Error in OCS_SENDMAIL::PROGRESS -
Error: " & Err.Number & " - " & Err.Description
50 Resume Progress_Exit
End Sub
Private Sub oVBSendMail_SendFailed(strExplanation As String)
Const RoutineName = "SendFailed"
Const Version = "1.0.0"
Dim strMsg As String
10 On Error GoTo SendFailed_Err
20 Forms![frmSendMailStatus].Caption = "Send Failed!"
30 DoCmd.Hourglass False
40 varErrorMessage = "XYR Send Mail - Send Failed for the following
reason:" & vbCrLf & strExplanation
SendFailed_Exit:
50 Set oVBSendMail = Nothing
60 Exit Sub
SendFailed_Err:
70 varErrorMessage = "Unexpected Error in OCS_SENDMAIL::SENDFAILED -
Error: " & Err.Number & " - " & Err.Description
80 Resume SendFailed_Exit
End Sub
Private Sub oVBSendMail_SendSuccesful()
Const RoutineName = "SendSuccesful"
Const Version = "1.0.0"
10 On Error GoTo SendSuccesful_Err
20 Forms![frmSendMailStatus].Caption = ""
30 DoCmd.Hourglass False
40 varErrorMessage = Null
SendSuccesful_Exit:
50 Set oVBSendMail = Nothing
60 Exit Sub
SendSuccesful_Err:
70 varErrorMessage = "Unexpected Error in OCS_SENDMAIL::SENDSUCCESFUL -
Error: " & Err.Number & " - " & Err.Description
80 Resume SendSuccesful_Exit
End Sub
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of jwcolby
Sent: Tuesday, December 30, 2008 3:03 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Application Error logging
This is a DLL correct? Which means a DLL register on any
machine it runs on?
John W. Colby
www.ColbyConsulting.com
Jim Dettman wrote:
> John,
>
> <<I have asked about a generic email and so far haven't found
> anything that "just works, every where, every time".>>
>
> Basically, you need to talk directly to a SMTP server. Even that
however
> is not foolproof, but it gets rid of about 90% of the hassle.
>
> You can use BLAT (script and shell out to call the command line or use
the
> DLL) or something like vbSendMail.
>
> I use the latter. Wrapped a class around it with a template table to
set
> defaults for all the options and then call that from my apps.
>
> Jim.
>
> -----Original Message-----
> From: accessd-bounces at databaseadvisors.com
> [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of jwcolby
> Sent: Tuesday, December 30, 2008 1:34 PM
> To: Access Developers discussion and problem solving
> Subject: Re: [AccessD] Application Error logging
>
> I have been looking for an email function that is generic,
> i.e. can just be written in code and work anywhere, any
> time. ATM I do email lots of stuff, but it is always done
> through Outlook automation, which of course requires Outlook
> to be available at the time the email is generated.
>
> I have asked about a generic email and so far haven't found
> anything that "just works, every where, every time".
>
> John W. Colby
> www.ColbyConsulting.com
>
>
> Heenan, Lambert wrote:
>> Me too! :-)
>>
>> Been logging errors since the beginning of time. My error logger also
> emails the error information to me. I also use MS Tools every day. Don't
> leave home without it.
>> Lambert
>>
>> P.S. Welcome back John.
>>
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com