autosend email based on content of incoming email

[shirley999]

I use VBA fairly confidently in Excel but have not got out of the starting blocks with Outlook.

What I would like to be able to do is to capture an email address from within the body of an incoming admin email, where the text would always be in the following format ...


Email Address : person at domain dot com

... and send that person a personal email

It would be all the better if their name could also be captured from within that admin email but I could live without that!


There is a new user, username

Please pitch this at my level and I will be very grateful. I began by recording macros, from where I have adapted the code in the Visual Basic Editor mostly in Excel, some in Word. I use rules and alerts in Outlook extensively but, as I've said, no macros yet, and no scripts.

And I'm a good and conscientious student!

[Oorang]

Depending on how sophisticated you wanted to go, you can actually do this with the rule builder... however here is a starting framework. I know at first blush it looks long, but I tried to document it for you. If you have questions feel free to post them:)

Make sure you place the Application_NewMailEx sub in the ThisOutlookSession module. The rest you can put where you like.

Option Explicit

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'---------------------------------------------------------------------------
' Procedure : Application_NewMailEx
' DateTime : 01/02/2008 01:26 AM 01:26
' Author : Aaron Bush
' Purpose : Responds to New Mail. Calls AutoReply for all new mail.
' Remarks : Error handler is set up so when an error is encountered
' procedure will procede to the next email after displaying
' error.
'---------------------------------------------------------------------------

Const strMailItem_c As String = "MailItem"
Const strDelimiter_c As String = ","
Const lngLwrBnd_c As Long = 0
Dim strEIDs() As String
Dim objOutlookItem As Object
Dim ns As Outlook.NameSpace
Dim lngEIDIndx As Long
Dim blnInLoop As Boolean
'Get current Outlook NameSpace for use with GetFromID method:
On Error GoTo Err_Hnd
Set ns = Outlook.Session
'As you can recieve multiple emails at once, load EIDs into array:
strEIDs = VBA.Split(EntryIDCollection, strDelimiter_c, _
Compare:=vbBinaryCompare)
'Mark as "In Loop" for error handler.
blnInLoop = True
'Loop through array of EIDs:
For lngEIDIndx = lngLwrBnd_c To UBound(strEIDs)
'Retrieve object that EID represents:
Set objOutlookItem = ns.GetItemFromID(strEIDs(lngEIDIndx))
'Test object to see if it is a MailItem (not calendar invitation etc.)
If VBA.TypeName(objOutlookItem) = strMailItem_c Then
AutoReplyTo objOutlookItem
End If
NextMailItem:
Next
blnInLoop = False
Exit Sub
Err_Hnd:
VBA.MsgBox "Error " & VBA.Err.Number & _
" in procedure Application_NewMailEx of VBA Document ThisOutlookSession" & _
vbNewLine & VBA.Err.Description, vbMsgBoxSetForeground Or vbSystemModal, _
"Error - Project1.ThisOutlookSession.Application_NewMailEx"
If blnInLoop Then
Resume NextMailItem
End If
End Sub

Public Sub AutoReplyTo(miInbound As Outlook.MailItem)
'---------------------------------------------------------------------------
' Procedure : AutoReplyTo
' DateTime : 01/02/2008 01:24 AM 01:24
' Author : Aaron Bush
' Purpose : Retrieves the name of the sender, and sends a stock reply to
' sender using said name.
' Input(s) : Email you want replied to.
'---------------------------------------------------------------------------
Const strSubject_c As String = "An important message from the Admin"
Const strTarget_c As String = "{Target}"
Const strStockText_c As String = "Hello {Target}," & vbNewLine & _
"Welcome to our party."
Dim strName As String
Dim strBody As String
Dim miOutbound As Outlook.MailItem
'Get Name of sender:
On Error GoTo Err_Hnd
strName = ExtractName(miInbound, False)
'If ExtractName fails with errors unsupressed, output will be a
'null string. This means the email will only be sent if there is a
'value in strName.
If VBA.LenB(strName) Then
'Update stock text with the username:
strBody = VBA.Replace(strStockText_c, strTarget_c, strName, _
Compare:=vbBinaryCompare)
'Build a new email to the user:
Set miOutbound = Outlook.CreateItem(olMailItem)
miOutbound.Body = strBody
miOutbound.Subject = strSubject_c
miOutbound.To = miInbound.SenderEmailAddress
'Send email:
miOutbound.Send
Set miOutbound = Nothing
End If
Exit Sub
Err_Hnd:
VBA.MsgBox "Error " & VBA.Err.Number & _
" in procedure AutoReplyTo of VBA Document ThisOutlookSession" & vbNewLine _
& VBA.Err.Description, vbMsgBoxSetForeground Or vbSystemModal, _
"Error - Project1.ThisOutlookSession.AutoReplyTo"
VBA.Err.Clear
End Sub
Private Function ExtractName(email As Outlook.MailItem, _
Optional suppressErrors As Boolean) As String
'---------------------------------------------------------------------------
' Procedure : ExtractName
' DateTime : 01/02/2008 01:10 AM 01:10
' Author : Aaron Bush
' Purpose : Turn an email address into a name equivilant.
' Input(s) : email - The email whose address you are trying to
' convert to a name.
' suppressErrors - If true function will not display an error
' when unable to parse, it will simply return
' the value found in emailAddress.
' Output(s) : User Name.
' Remarks : Only handles SMTP and Exchange Email.
'---------------------------------------------------------------------------
Const strExchange_c As String = "EX"
Const strSMTP_c As String = "SMTP"
Const strFrwdSlsh_c As String = "/"
Const strAt_c As String = "@"
Const lngOffset_c As Long = 1
Const lngErrParseFail_c As Long = vbObjectError + 514
Dim lngDlmtrPos As Long
Dim strRtrnVal As String
Dim strFrom As String
On Error GoTo Err_Hnd
strFrom = email.SenderEmailAddress
Select Case email.SenderEmailType
Case strExchange_c
lngDlmtrPos = VBA.InStr(strFrom, strAt_c, Compare:=vbBinaryCompare)
'All positive and negative numeric values are evaluated as boolean
'"True", so if that "@" sign is not found, "lngDlmtrPos" will be 0
'("False") and code will generate an alert.
If lngDlmtrPos Then
'Extract name from email.
strRtrnVal = VBA.Mid$(strFrom, lngOffset_c, lngDlmtrPos - _
lngOffset_c)
Else
VBA.Err.Raise lngErrParseFail_c
End If
Case strSMTP_c
lngDlmtrPos = VBA.InStr(strFrom, strFrwdSlsh_c, _
Compare:=vbBinaryCompare)
'All positive and negative numeric values are evaluated as boolean
'"True", so if that "/" sign is not found, "lngDlmtrPos" will be 0
'("False") and code will generate an alert.
If lngDlmtrPos Then
'Extract name from email.
strRtrnVal = VBA.Mid$(strFrom, lngDlmtrPos + lngOffset_c)
Else
VBA.Err.Raise lngErrParseFail_c
End If
End Select
ExtractName = strRtrnVal
Exit Function
Err_Hnd:
If suppressErrors Then
ExtractName = strFrom
ElseIf VBA.Err.Number = lngErrParseFail_c Then
VBA.Err.Raise vbObjectError, , _
"Procedure ExtractName cannot parse email address: """ & strFrom & """."
Else
VBA.MsgBox "Error " & VBA.Err.Number & _
" in procedure ExtractName of VBA Document ThisOutlookSession" & _
vbNewLine & VBA.Err.Description, vbMsgBoxSetForeground Or vbSystemModal, _
"Error - Project1.ThisOutlookSession.ExtractName"
End If
VBA.Err.Clear
End Function

[shirley999]

I'm going to say a huge thank you now, Aaron, and will post back when I have tried it. Unfortunately, it's back to the day job today!

[shirley999]

I'm not sure where to start with my questions! I have put your code in 'as is' because it's all new to me. I sent myself an email with a couple of words followed by my email address in the body and generated an error that included my email address. You can either give up on me now or hopefully you are a very patient person!

I realise now I didn't give you enough information. I really need to be able to send a standard email which is saved as a signature because I am trying to send something that looks pretty, not just plain text. Sorry, I should have mentioned this detail at the outset. I am trying this approach because I can only send a plain text email from within Vbulletin forum, and not HTML.

It will have to be a rule also because I don't want to respond to every email that has an email address in the body. How do I link the two? I feel very cheeky asking so many what must be fairly basic questions. If you know of a good introduction I can read I'll be grateful and will do the groundwork I feel as if I very much need.

Many thanks once again.

[shirley999]

Actually it's the email address of the sender that's showing up in the error messages.