[AccessD] automating Outlook - class Email

[John Colby]

The email class is handed an email by the outlook class.  The email's
purpose is to grab the email pieces and store them in module level
variables, then create a record in tblEmail.  It is pretty simple.

One thing that is happening is that if I hold on to the email object from
Outlook for very long, I will get an automation error when I try to use the
pieces of it.  For this reason I use this class to grab what I want for
later.  After grabbing these pieces I never touch the actual email object
again.  I originally thought I'd hold the pointer to the email and use it
as desired.  No such luck, automation error!

Option Compare Database
Option Explicit

Private mEM_PKID As Integer
Private mTypeID As Integer
Private mSenderEmailAddress As String
Private mSentOn As String
Private mReceivedTime As String
Private mSubject As String
Private mSize As String
Private mBody As String

Property Get pSenderEmailAddress()
    pSenderEmailAddress = mSenderEmailAddress
End Property
Property Get pSentOn()
    pSentOn = mSentOn
End Property
Property Get pReceivedTime()
    pReceivedTime = mReceivedTime
End Property
Property Get pSubject()
    pSubject = mSubject
End Property
Property Get pSize()
    pSize = mSize
End Property
Property Get pBody()
    pBody = mBody
End Property


' ----------------------------------------------------------------
' Procedure Name: mInit
' Purpose: Grabs the pieces of the email we care about into module level
variables
' Procedure Kind: Function
' Procedure Access: Public
' Parameter lMailItem (MailItem): This is the email object from Outlook
' Author: John Colby
' Date: 8/21/2021
' ----------------------------------------------------------------
Function mInit(lMailItem As MailItem)
    On Error GoTo mInit_Error
Dim lProperty As Property

    With lMailItem
        mTypeID = 1
        mSenderEmailAddress = .SenderEmailAddress
        mSentOn = .SentOn
        mReceivedTime = .ReceivedTime
        mSubject = .Subject
        mBody = .Body
    End With
    fStoreEmail 'lMailItem

Exit_mInit:
    On Error GoTo 0
    Exit Function

mInit_Error:
Dim strErrMsg As String
    Select Case Err
    Case 0      'insert Errors you wish to ignore here
        Resume Next
    Case Else   'All other errors will trap
        strErrMsg = "Error " & Err.Number & " (" & Err.Description & ") in
procedure Advisor Notes Administration.clsEMail.mInit, line " & Erl & "."
        Beep
#If boolELE = 1 Then
        WriteErrorLog strErrMsg
#End If
        assDebugPrint strErrMsg
        Resume Exit_mInit
    End Select
    Resume Exit_mInit
    Resume 0    'FOR TROUBLESHOOTING
End Function

' ----------------------------------------------------------------
' Procedure Name: fStoreEmail
' Purpose: Stores the email information in tblEmail
' Procedure Kind: Function
' Procedure Access: Public
' Author: John Colby
' Date: 8/21/2021
' ----------------------------------------------------------------
Function fStoreEmail()
    On Error GoTo fStoreEmail_Error
Dim db As DAO.Database
Dim rst As DAO.Recordset

    Set db = CurrentDb
    Set rst = db.OpenRecordset("tblEmail", dbOpenDynaset)

    With rst
        .AddNew
        !EM_TypeID = mTypeID
        !EM_SenderEmailAddr = mSenderEmailAddress
        !EM_SentOn = mSentOn
        !EM_ReceivedTime = mReceivedTime
        !EM_Subject = mSubject
        !EM_Body = mBody
        .Update
        .Bookmark = .LastModified
        mEM_PKID = !EM_PKID 'Grab the PKID from the new record
    End With

Exit_fStoreEmail:
    On Error GoTo 0
    Exit Function

fStoreEmail_Error:
Dim strErrMsg As String
    Select Case Err
    Case 0      'insert Errors you wish to ignore here
        Resume Next
    Case Else   'All other errors will trap
        strErrMsg = "Error " & Err.Number & " (" & Err.Description & ") in
procedure Advisor Notes Administration.clsEMail.fStoreEmail, line " & Erl &
"."
        Beep
#If boolELE = 1 Then
        WriteErrorLog strErrMsg
#End If
        assDebugPrint strErrMsg
        Resume Exit_fStoreEmail
    End Select
    Resume Exit_fStoreEmail
    Resume 0    'FOR TROUBLESHOOTING
End Function



-- 
John W. Colby
Colby Consulting