?
Solved

Outlook Customized Rules

Posted on 2014-03-15
8
Medium Priority
?
215 Views
Last Modified: 2014-03-21
I have a vba rule that runs in outlook each time an email is received. I would like to have it quickly access a list (maybe in excel or a text file) and make a choice where a copy of the email is stored based on the information in the list.

Is there an easy / fast way to have outlook open and filter a list like this.

I thought of loading the list one time upon opening as an array but I'm not familiar with using arrays.

Thanks
0
Comment
Question by:rogerdjr
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
8 Comments
 
LVL 52

Expert Comment

by:Rgonzo1971
ID: 39932450
HI,

Could you be more precise

Which OL version you have?

What do you want to do with the array data, if not in the array what should the rule do?

Regards
0
 

Author Comment

by:rogerdjr
ID: 39932613
I'm using Outlook 2013

What I am trying to do, as a start, is create a list with two columns:

Column 1 - Job # / Key Word
Column 2 - Folder

The rule would search the list for a matching (Job # / Key Word) in the subject or body of the email and move a copy to the appropriate (Folder)

I would populate the array with information from a spreadsheet list when Outlook opens and use the array for all emails received.

The reason I'm considering the array is that when I tried this code to open excel with each email it was way too slow:

Thanks

----------------------------------------------------------------------------------------------------------
Sub MyRule(Item As Outlook.MailItem)
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objContact As Outlook.ContactItem
    Dim objItems As Outlook.Items
    Dim objContactsFolder As Outlook.MAPIFolder
    Dim obj As Object
   
    Dim NameFilter As String, strFile As String, i As Integer
   
    Dim RowNo As Integer, MaxRows As Integer
   
    Set xlApp = CreateObject("Excel.Application")

    If xlApp = "Microsoft Excel" Then
   
    Else
        With xlApp
            .Visible = True
            .EnableEvents = False
        End With
    End If
   
    strFile = "C:\Personal\OutlookData\OutlookRuleFileEmails.xlsm"
On Error GoTo openit
    If sourceWB.Name <> "OutlookRuleFileEmails.xlsm" Then
openit:
        Set sourceWB = xlApp.Workbooks.Open(strFile) ', , False, , , , , , , True)
        Set sourceWS = sourceWB.Worksheets("EmailRule")
        sourceWB.Activate
    End If
   
    Set objOL = CreateObject("Outlook.Application")
    Set objNS = objOL.GetNamespace("MAPI")
    Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
    Set objItems = objContactsFolder.Items

    NameFilter = "[Email1Address] = " & """" & Item.SenderEmailAddress & """"
   
    Set objContact = objItems.Find(NameFilter)
   
On Error GoTo NoContactFound
   
        If objContact.Class = olContact Then
            RowNo = 1
            MaxRows = sourceWS.Cells(1, 1)
       
            While RowNo <= MaxRows
                    MsgBox "Second " & vbNewLine & Item.Subject & vbNewLine & Item.SenderEmailAddress & vbNewLine & NameFilter & vbNewLine & objContactsFolder.Name & vbNewLine & objContact.Email1Address & vbNewLine & Format(Item.ReceivedTime, "mm/dd/yyyy") & vbNewLine & sourceWS.Cells(i, 2) & vbNewLine & sourceWS.Cells(i, 3) & vbNewLine & i
               
                If Item.SenderEmailAddress = sourceWS.Cells(i, 2) Then
                    MsgBox "Third " & vbNewLine & Item.Subject & vbNewLine & Item.SenderEmailAddress & vbNewLine & NameFilter & vbNewLine & objContactsFolder.Name & vbNewLine & objContact.Email1Address & vbNewLine & Format(Item.ReceivedTime, "mm/dd/yyyy") & vbNewLine & sourceWS.Cells(i, 2) & vbNewLine & sourceWS.Cells(i, 3) & vbNewLine & i
                    objContact.Body = objContact.Body & vbNewLine & "--------------------" & vbNewLine & Format(Item.ReceivedTime, "mm/dd/yyyy") & " " & Item.Subject & vbNewLine & sourceWS.Cells(i, 3)
                    objContact.Save
                End If
               
                RowNo = RowNo + 1
            Wend
        End If
NoContactFound:

End Sub
0
 
LVL 52

Expert Comment

by:Rgonzo1971
ID: 39933568
Hi,

First you have to place your code in the this outlook module

the Variable
Private arrDataForRules As Variant before any code

the startup event will fire Private Sub Application_Startup()

then the arrDataForRules data will be available to the other macro in your module

Private arrDataForRules As Variant
Private Sub Application_Startup()


    Set xlApp = CreateObject("Excel.Application")

    If xlApp = "Microsoft Excel" Then

    Else
        With xlApp
            .Visible = True
            .EnableEvents = False
        End With
    End If

    strFile = "C:\Personal\OutlookData\OutlookRuleFileEmails.xlsm"
On Error GoTo openit
    If sourceWB.Name <> "OutlookRuleFileEmails.xlsm" Then
openit:
        Set sourceWB = xlApp.Workbooks.Open(strFile) ', , False, , , , , , , True)
        Set sourceWS = sourceWB.Worksheets("EmailRule")
        sourceWB.Activate
        sourceWS.Activate
        Set myRange = Range(Range("B1"), Range("C" & Cells.Rows.Count).End(xlUp))
        arrDataForRules = myRange
    End If

End Sub

Sub Macro()
arrD = arrDataForRules ' so you can see the values in the Locals Window
For Idx = LBound(arrDataForRules) To UBound(arrDataForRules)
    MsgBox arrDataForRules(Idx, 1)
    MsgBox arrDataForRules(Idx, 2)
Next
End Sub

Open in new window

Regards
0
Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

 

Author Comment

by:rogerdjr
ID: 39934459
Thanks

I'll work on it later today
0
 

Author Comment

by:rogerdjr
ID: 39944263
Hmm

Can't seem to get it to run

First it required me to define variables so I edited as follows:

Sub Macro()
Dim arrD As Variant, arrDataForRules As String, idx As Variant
arrD = arrDataForRules ' so you can see the values in the Locals Window
For idx = LBound(arrDataForRules) To UBound(arrDataForRules)
    MsgBox arrDataForRules(idx, 1)
    MsgBox arrDataForRules(idx, 2)
Next
End Sub

Then when I try to run the macro I get an error message with lbound highlighted that says "Compile error: Expected array"

Sorry I'm a novice at using arrays - I hope you can help.

Thanks
0
 

Author Comment

by:rogerdjr
ID: 39944434
Further trouble shooting?? - the start-up macro doesn't seem to run - I modified it as follows to test for a value when I run the macro under a different name it works fine but as the start-up macro it doesn't run - do I need to change a setting?

Using Outlook 2013?

Private Sub Application_Startup()

    Dim strFile As String
       
    Set xlApp = CreateObject("Excel.Application")

    If xlApp = "Microsoft Excel" Then

    Else
        With xlApp
            .Visible = True
            .EnableEvents = False
        End With
    End If

    strFile = "C:\Personal\OutlookData\OutlookRuleFileEmails.xlsm"
On Error GoTo openit
    If sourceWB.Name <> "OutlookRuleFileEmails.xlsm" Then
openit:
        Set sourceWB = xlApp.Workbooks.Open(strFile) ', , False, , , , , , , True)
        Set sourceWS = sourceWB.Worksheets("EmailRule")
        sourceWB.Activate
        sourceWS.Activate
'        Set myRange = Range(Range("B1"), Range("C" & Cells.Rows.Count).End(xlUp))
'        arrDataForRules = myRange
    End If

msgbox = sourceWS.Cells(3, 2)


End Sub
0
 
LVL 52

Accepted Solution

by:
Rgonzo1971 earned 2000 total points
ID: 39944600
Hi,

Is your security setting medium?

is your code in the ThisOutlook module

pls test startup event with this little code

Private Sub Application_Startup() 
 MsgBox "Welcome, " & Application.GetNamespace("MAPI").CurrentUser 
End Sub

Open in new window

then Close Outlook and reopen it

Regards
0
 

Author Closing Comment

by:rogerdjr
ID: 39945439
Amazing - I moved the code to the ThisOutlookSession Module and it worked like a dream.

This is why I subscribe to Experts Exchange!!!!!!!
0

Featured Post

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
This article helps those who get the 0xc004d307 error when trying to rearm (reset the license) Office 2013 in a Virtual Desktop Infrastructure (VDI) and/or those trying to prep the master image for Microsoft Key Management (KMS) activation. (i.e.- C…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
Suggested Courses

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question