-
Notifications
You must be signed in to change notification settings - Fork 0
/
M_clsLogSaver_EMail_Outlook.def
170 lines (139 loc) · 4.42 KB
/
M_clsLogSaver_EMail_Outlook.def
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module : clsLogSaver_EMail_Exchange
' Author : K.Gundermann
' Date : 17.01.2012
' Purpose : Sends Logger Events to a EMail Recipient using Outlook
' Remark : Needs Microsoft Outlook xx.x Object Library
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
#Const Outlook = 1
Implements ILogSaver
Private WithEvents c_Logger As clsLogger
Attribute c_Logger.VB_VarHelpID = -1
Private WithEvents c_Session As clsLogSession
Attribute c_Session.VB_VarHelpID = -1
Private c_Filters As clsLogFilterCollection
' Private Const olMailItem = 0
Private c_Name As String
Private c_EmailTo As String
Private c_EMailSubject As String
Private Sub Class_Initialize()
Set c_Session = Logger.Log.Session
Set c_Filters = New clsLogFilterCollection
End Sub
Private Sub Class_Terminate()
Call StopLog
End Sub
' --- Public Interface ---
Public Sub StartLog()
Set c_Logger = Logger.Log
End Sub
Public Sub StopLog()
Set c_Logger = Nothing
End Sub
Public Sub SaveToLog(ByRef objLogEntry As clsLogEntry)
If Filters.MatchFilter(objLogEntry) Then
Call SaveToMyLog(objLogEntry)
End If
End Sub
Public Function AddFilter(ByVal TheFilter As clsLogFilter) As ILogSaver
Filters.AddFilter TheFilter
Set AddFilter = Me
End Function
Public Property Get ID() As Long
ID = ObjPtr(Me)
End Property
Public Property Get Name() As String
If c_Name = vbNullString Then
Name = TypeName(Me)
Else
Name = c_Name
End If
End Property
Public Property Let Name(ByVal TheName As String)
c_Name = TheName
End Property
' --- Private Functions ---
Private Property Get Filters() As clsLogFilterCollection
Set Filters = c_Filters
End Property
' --- Event Handler for Logger/Session Class ---
Private Sub c_Logger_SaveToLog(objLogEntry As clsLogEntry)
Call Me.SaveToLog(objLogEntry)
End Sub
Private Sub c_Session_Login()
' ToDo: We have now a logged In User
End Sub
Private Sub c_Session_Logout()
' ToDo: The user has logged out
End Sub
' --- Implements ILogSaver ---
Private Sub ILogSaver_StartLog()
Me.StartLog
End Sub
Private Sub ILogSaver_StopLog()
Me.StopLog
End Sub
Private Function ILogSaver_AddFilter(ByVal TheFilter As clsLogFilter) As ILogSaver
Set ILogSaver_AddFilter = Me.AddFilter(TheFilter)
End Function
Private Property Get ILogSaver_ID() As Long
ILogSaver_ID = Me.ID
End Property
Private Property Get ILogSaver_Name() As String
ILogSaver_Name = Me.Name
End Property
Private Property Let ILogSaver_Name(ByVal TheName As String)
Me.Name = TheName
End Property
Private Sub ILogSaver_SaveToLog(objLogEntry As clsLogEntry)
Call Me.SaveToLog(objLogEntry)
End Sub
' ---------------------------------------------------------------------------------
' -- Specific Functions for that logger here
Public Property Get EmailTo() As String
EmailTo = c_EmailTo
End Property
Public Property Let EmailTo(ByVal TheReceiver As String)
c_EmailTo = TheReceiver
End Property
Public Property Get EMailSubject() As String
If IsNullString(c_EMailSubject) Then
EMailSubject = TypeName(Me)
Else
EMailSubject = c_EMailSubject
End If
End Property
Public Property Let EMailSubject(ByVal TheSubject As String)
c_EMailSubject = TheSubject
End Property
Private Sub SendMail(ByVal TheMessage As String)
#If Outlook Then
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Set olApp = New Outlook.Application
If olApp Is Nothing Then Exit Sub
Set olNS = olApp.GetNamespace("MAPI")
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = Me.EmailTo
.Subject = Me.EMailSubject
.Body = TheMessage
.Send
End With
#Else
Err.Raise vbObjectError, , "Outlook Integration is not enabled in this App!"
#End If
End Sub
Private Function LogEntry2String(ByVal objLogEntry As clsLogEntry) As String
LogEntry2String = Logger.Log.Session.ToString & vbCrLf & objLogEntry.ToString
End Function
Private Sub SaveToMyLog(ByRef objLogEntry As clsLogEntry)
SendMail LogEntry2String(objLogEntry)
End Sub