Celebrate National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

How can I eliminate the category coding from Outlook

Posted on 2011-02-22
5
Medium Priority
?
314 Views
Last Modified: 2012-05-11
The coding below works like a charm, but is it possible to eliminate the need to always having to select a category when emailing? Below is a picture of what I'm doing each time I send an email. It would be nice if I could just send my email without having to select what category the contact was under to update "Date of Last Contact". Please advise.

Outlook-process01
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'Change the category name as needed'
    Const TGT_CAT = "MassMail"
    Const MACRO_NAME = "Item Send"
    Dim olkFolder As Outlook.Items, olkContact As Outlook.ContactItem, olkProp As 

Outlook.UserProperty
    '--- Turn off error handling ---'
    On Error Resume Next
    '--- If the item being sent as an email ---'
    If Item.Class = olMail Then
        '--- If the item being sent is a member of the target category ---'
        If InStr(1, Item.Categories, TGT_CAT) Then
            '--- Get the Cotnacts folder ---'
            Set olkFolder = Session.GetDefaultFolder(olFolderContacts).Items
            '--- Was the contacts folder found? ---'
            If TypeName(olkFolder) = "Nothing" Then
                '--- No ---'
                MsgBox "Could not find the Contacts folder", vbCritical + vbOKOnly, MACRO_NAME
            Else
                '--- Yes ---'
                '--- Get the contact associated with the recipient email address ---'
                Set olkContact = olkFolder.Find("[Email1Address] = '" & 

Item.Recipients.Item(1).Address & "'")
                '--- Was a matching contact found? ---'
                If TypeName(olkContact) = "Nothing" Then
                    '--- No ---'
                    MsgBox "Could not find a contact with the address " & 

Item.Recipients.Item(1).Address & " in the first email address slot.", vbCritical + vbOKOnly, 

MACRO_NAME
                Else
                    '--- Yes ---'
                    '--- Update the Last Contact property ---'
                    Set olkProp = olkContact.UserProperties("Date of Last Contact") '<- Change the 

property name as needed'
                    olkProp.Value = Now
                    '--- Update the Attempts property ---'
                    Set olkProp = olkContact.UserProperties("Number of Attempts")   '<- Change the 

property name as needed'
                    olkProp.Value = Int(olkProp.Value) + 1
                    '--- Save the changes ---'
                    olkContact.Save
                End If
            End If
        End If
    End If
    On Error GoTo 0
    Set olkFolder = Nothing
    Set olkContact = Nothing
    Set olkProp = Nothing
End Sub

Open in new window

0
Comment
Question by:brokerexecutives
[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
  • 3
  • 2
5 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 34957651
Yes, we can eliminate the need to select a category if you want the code to fire for every message you send.  If not, then the code needs some means of discriminating between those it sohould run for and those it shouldn't run for.  That doesn't have to be a category, the category was just a convenient means of accomplishing this.  

Should the code process all emails or only certain ones?
0
 

Author Comment

by:brokerexecutives
ID: 34957702
90% of the people I contact are in my Outlook contacts. What harm would it do if the email was sent and a contact didn't exist?

I would love the code to work all the time. I'm constantly updating contacts with Date of Last Contact, so that would save me a ton of time.

I also attempted to do a mail-merge right now and couldn't find anywhere to select a category, so I think it would be necessary to not have it defined by category in order to send mail-merge.  
0
 
LVL 76

Accepted Solution

by:
David Lee earned 2000 total points
ID: 34957858
It won't do any harm.  You'll get a popup message saying that the code couldn't find a matching contact.  I can remove that too if you want.

I've modified the code and removed the category portion.

I'm shutting down for the evening.  I'll be back on tomorrow.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Const MACRO_NAME = "Item Send"
    Dim olkFolder As Outlook.Items, olkContact As Outlook.ContactItem, olkProp As Outlook.UserProperty
    '--- Turn off error handling ---'
    On Error Resume Next
    '--- If the item being sent as an email ---'
    If Item.Class = olMail Then
        '--- Get the Cotnacts folder ---'
        Set olkFolder = Session.GetDefaultFolder(olFolderContacts).Items
        '--- Was the contacts folder found? ---'
        If TypeName(olkFolder) = "Nothing" Then
            '--- No ---'
            MsgBox "Could not find the Contacts folder", vbCritical + vbOKOnly, MACRO_NAME
        Else
            '--- Yes ---'
            '--- Get the contact associated with the recipient email address ---'
            Set olkContact = olkFolder.Find("[Email1Address] = '" & Item.Recipients.Item(1).Address & "'")
            '--- Was a matching contact found? ---'
            If TypeName(olkContact) = "Nothing" Then
                '--- No ---'
                MsgBox "Could not find a contact with the address " & Item.Recipients.Item(1).Address & " in the first email address slot.", vbCritical + vbOKOnly, MACRO_NAME
            Else
                '--- Yes ---'
                '--- Update the Last Contact property ---'
                Set olkProp = olkContact.UserProperties("Date of Last Contact") '<- Change the property name as needed'
                olkProp.Value = Now
                '--- Update the Attempts property ---'
                Set olkProp = olkContact.UserProperties("Number of Attempts")   '<- Change the property name as needed'
                olkProp.Value = Int(olkProp.Value) + 1
                '--- Save the changes ---'
                olkContact.Save
            End If
        End If
    End If
    On Error GoTo 0
    Set olkFolder = Nothing
    Set olkContact = Nothing
    Set olkProp = Nothing
End Sub

Open in new window

0
 

Author Comment

by:brokerexecutives
ID: 34957935
HAHAHHA. It worked! You are a genius! Like, I said, I owe you more than just point. You send me an email and I'll send you some cash. Seriously. Thank you sir! Big Smiles over here in Arizona!
0
 

Author Closing Comment

by:brokerexecutives
ID: 34957937
It worked like a charm. Thank you BDF.
0

Featured Post

NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

Question has a verified solution.

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

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…

730 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