jwcolby
jwcolby at colbyconsulting.com
Tue Dec 30 16:18:05 CST 2008
Cool, I will try it out.
What you do for the SMTP Server? Are there "public"
servers? I know NOTHING about this stuff.
John W. Colby
www.ColbyConsulting.com
Jim Dettman wrote:
> 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.
>>>