Figure 3 IsUserValid
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Name: Public Function IsUserValid(eMailAddress As String) As
'Boolean
'Purpose: this function queries the database making sure the that name
'of the sender is in the database.
'Params: EMailAddress of the user
'Return Boolean True if EMailAddress if a valid user false if not.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function IsUserValid(eMailAddress As String) As Boolean
Dim strSQL As String
Dim rstUser As Variant
'Inilize Select Query
strSQL = "Select * From tblUsers Where txtUserNameInOutlook = _
'" & eMailAddress & "';"
Set rstUser = ExecuteSQL(strSQL)
'Return Value
If Not (rstUser.BOF And rstUser.EOF) Then
IsUserValid = True
Else
IsUserValid = False
End If
End Function
Figure 6 MainDriver (VBA Outlook Macro)
'Author - Daniel Williams and Alok Mehta
'Date - 7/25/2001
'For MSDN Article
Const strMailBoxName = "Mailbox - RDMSDN" 'Mailbox pointer
Private Sub Application_NewMail()
'This is the "Main Driver" for the sample application.
'The purpose of this routine is to receive the new email
'and pass the message to the COM object which then processes
'the request stored in the message body. 'Application_NewMail
'is an event that gets fired by Outlook every time a new message arrives. Dim msg As Outlook.MailItem 'Outlook Object Model allows us
'to declare an object of type MailItem.
'Note that if the Inbox receives a meeting request
'or other type of the item an error will occur.
'To avoid this, Dim msg As Object
Dim strSubject As String 'Worker String
Dim fldInbox As Outlook.MAPIFolder 'Outlook Object Model - MAPI
'Folder
Dim gnspNameSpace As Outlook.NameSpace
Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
'Model - MAPI Namespace
Set fldInbox = gnspNameSpace.Folders(strMailBoxName).Folders("Inbox")
'Outlook Object Model - Pointer to the Mail Box and its Inbox
For Each msg In fldInbox.Items 'Iterate through all Messages
strSubject = msg.Subject 'Get the Subject of the current
'message
If msg.UnRead = True Then 'If the message is unread then
'proceed
'Message must have QUERY in the Subject to proceed
If InStr(1, UCase(strSubject), "QUERY") > 0 Then
'Message once proceesed are marked so we do not process
'them again
If InStr(1, strSubject, "*PROCESSED*") <= 0 Then
'Message with an error
If InStr(1, strSubject, "*NOT PROCESSED*") <= 0 Then
'Message must have something in the body
If (Len(msg.Body) > 0) Then
'All conditions are satisfied, now we can proceed
'to access the data access component
Dim objFurniture As Object
'Instance of the data access component
Set objFurniture = CreateObject( _
"DataAccessComponent.clsEmailProcessor")
'validate user
If (objFurniture.IsUserValid(msg.SenderName)) _
Then
'message is passed to the component for
'processing
Call objFurniture.ProcessEmail(msg)
Else
'Invalid user
End If
'kill the object
Set objFurniture = Nothing
End If
End If
End If
End If
Else
' Message doesn't meet criteria.
End If
Next
End Sub
Figure 7 ProcessEmail
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Name: Public Function ReturnAnswer(eMailSubject As String,
' eMailBody As String) As String
'Params: eMailSubject subject of the email
' eMailBody body of the email
'Return String that replies offers a reply to the user.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ProcessEmail(eMail As Object)
Dim arrEMailBody As Variant 'body of the email in the form of an array
Dim aryQryParams As Variant 'array of parameters extracted from the
'body of the e-mail
Dim rstResult As Variant 'resulting recordset
Dim strQryName As String 'Name of the query requested
Dim strQry As String 'Query to be exectued
Dim intQueryType As Integer 'type of query resquested
If eMail.Body <> "" Then
'Split e-mail body into an array
arrEMailBody = SplitEmailBody(eMail.Body)
If UBound(arrEMailBody) >= 1 Then
'Get the query name from within the body
strQryName = ReturnQueryName(arrEMailBody)
'Get the array of the query from within the body
aryQryParams = ReturnQueryParams(arrEMailBody)
'Get the type of query based on the name
intQueryType = ReturnQueryType(strQryName)
If strQryName <> INVALID_RESULT Then
'build the sql statment replacing the ? with parameters
strQry = ContructSQL(strQryName, aryQryParams)
' if no errors occur execute the query, format the response
If strQry <> INVALID_RESULT Then
Set rstResult = ExecuteSQL(strQry)
Call FormatEMailResponse(strQryName, intQueryType,
rstResult, eMail)
eMail.UnRead = False
eMail.Save
eMail.Send 'send the email
Else ' otherwise
eMail.Subject = eMail.Subject & " *NOT PROCESSED*"
eMail.Body = eMail.Body & vbCr & vbCr & "There was" &
"an error processing your request."
eMail.UnRead = False
eMail.Save
eMail.Send
End If
End If
End If
End If
End Sub
Figure 8 SplitEmailBody
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Name: Private Function SplitEmailBody(strEMailBody As String) As
' Variant
'
'Purpose: Uses the split function to turn the email body into an array.
'
'Params: strEMailBody body of the email
'Return Variant as array
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function SplitEmailBody(strEMailBody As String) As Variant
Dim arrBody As Variant 'the body of the email in an array
Dim intCnt As Integer 'number of lines in the email
Dim intIndex As Integer 'index counter
intCnt = 0 'set counter
intIndex = 1 'set index
'count the number of lines in the body of the email
While InStr(intIndex, strEMailBody, vbCr) <> 0
intCnt = intCnt + 1
intIndex = InStr(intIndex, strEMailBody, vbCr) + 1
Wend
ReDim arrBody(intCnt) 'redimension the array to be the size of
'intCnt
arrBody = Split(strEMailBody, vbCr) 'split the email into an array
For intIndex = 1 To intCnt
arrBody(intIndex) = Mid(arrBody(intIndex), 2, _
Len(arrBody(intIndex)) - 1)
Next intIndex
SplitEmailBody = arrBody
End Function
Figure 9 ConstructSQL
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Name: Private Function ContructSQL(strQueryName As String,
' arrParam() As String) As String
'Params: strQueryName name of the query as it appears in the database.
' arrParam - array of string that will serve as parameters
' to the query
'Return String - A Query in the form of a string that contains ?
' where each parameter should go.
' -1 = error
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function ContructSQL(strQueryName As String, arrParam As Variant) As String
Dim intParamCnt As Integer 'number of parameters expected in the query
Dim intArrayCnt As Integer 'number of items in the array
Dim intIndex As Integer 'index for FOR loop
Dim strQuery As String 'Query from the database
Dim strSQL As String 'locally created query used to get requested
'query string.
Dim rst1 As Variant 'the recordset that returns the requested
'query string
On Error Resume Next
If Err.Number > 0 Then Err.Clear
intArrayCnt = UBound(arrParam) + 1
If Err.Number > 0 Then
intArrayCnt = 0
Err.Clear
End If
On Error GoTo 0
'this is the query that will retrive the requested query from the
'database
strSQL = "Select txtQuery From tblQueries Where txtQueryName = '" _
& Trim(strQueryName) & "';"
Set rst1 = ExecuteSQL(strSQL) 'recordset which should contain the
'requested query
If Not (rst1.EOF And rst1.BOF) Then
'if the recordset is empty then the query did not exist
'otherwise continue the actual requested query
strQuery = rst1("txtQuery")
intParamCnt = GetParamCount(strQuery) 'number of parameters that
'the user supplied us
If intArrayCnt = intParamCnt Then 'if the array contains as
'many item as the requested
'query contains"?" then we
'can continue
If intArrayCnt <> 0 Then
For intIndex = 0 To intParamCnt - 1
strQuery = Replace(strQuery, "?", _
Trim(arrParam(intIndex)), 1, 1)
Next intIndex
End If
ContructSQL = strQuery 'return the query with the params
'in place.
Else
ContructSQL = "INVALID_RESULT" 'wrong number of params for
'the requested query
End If
Else
ContructSQL = INVALID_RESULT 'no query exists with the
'requested name
End If
End Function
Figure 10 tblQueries Content
Query Name
| Query
| Description
| Delete_Inventory_ID
| Delete FromtblInventory Wehre intID=?
| Deletes an item in the inventory table based on ID (paramenters required: 1- ID)
| Help
| Select tblQueries.textQueryName, tblQueries.txtQueryDescription, tblQueriesType.txtQueryType From tblQueries, tblQueryType Where tblQueryType.intQueryType= tblQueries.intQueryType
| Returns all of the available queries (parameters required: 0)
| Insert_Inventory
| Insert Into tblInventory (txt Description, txtDepartment, curPrice, [curRetail Cost], intCount) Values ('?', '?', ?, ?, ?);
| Inserts a new record into the inventory table (parameters required: 5- Description, Department, Price, Retail Price, Count)
| Select_Inventory_All
| Select* FromtblInventory
| Returns all inventory (parameters required: 0)
| Select_Inventory_Department
| Select* FromtlbInventory Where txtDepartment=?
| Returns all inventory based on Department (paramenters required: 1- Department)
| Select_Inventory_ID
| Select* FromtblInventory Where intID=?
| Returns all inventory based on ID (parameters required: 1- ID)
| Update_Inventory_ID
| Update tblInventory Set tblInventory.txtDescription = ?, tblInventory.txtDepartment = ?, tblInventory.curPrice = ?, tblInventory.[curRetail Cost] = ?, tblInventory.intCount = ? Where ((([tblInventory].[intID])=?));
| Updates a current item in inventory (parameters required: 1- ID)
| |