home | get Sue’s code | forums | share code | registration

Outlook Technologies

Outlook Forms

Languages

Samples

More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 09-Feb-2010 11:13

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Code level: intermediate Code area: Basic Outlook Printer Friendly Version
Title: Corrected Defining a Domain Property column
Description: Allows a Domain Property to be used as a sortable/groupable column
Date: 24-Aug-2003 23:33
Code level: intermediate
Code area: Basic Outlook
Posted by: Dale Cooper
Body: <======= Place in 'ThisOutlookSession' =======> Option Explicit Private WithEvents olInboxItems As Items Private Sub Application_Quit() ' disassociate global objects Set olInboxItems = Nothing Call UnsetCDOSession End Sub Private Sub olInboxItems_ItemAdd(ByVal Item As Object) Dim objProp As UserProperty If Item.Class = olMail Then Call SetFromDomain(Item, GetFromDomain(Item)) End If End Sub Private Sub Application_Startup() Dim objNS As NameSpace Set objNS = Application.GetNamespace("MAPI") Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items ' start CDO session Call SetCDOSession End Sub <======= Place with your other modules =======> Option Explicit Public G_objSession As MAPI.Session Sub SetCDOSession() ' start CDO session Set G_objSession = CreateObject("MAPI.Session") G_objSession.Logon , , False, False End Sub Sub UnsetCDOSession() ' start CDO session Set G_objSession = Nothing End Sub Function GetFromAddress(objMsg As MailItem) As String Dim strEntryID As String Dim strStoreID As String Dim objCDOItem As MAPI.Message ' get EntryID and StoreID for message strEntryID = objMsg.EntryID strStoreID = objMsg.Parent.StoreID If G_objSession Is Nothing Then ' Set the CDO Session up as it doesn't exist. Call SetCDOSession End If ' pass item to CDO and get sender address On Error Resume Next Set objCDOItem = G_objSession.GetMessage(strEntryID, strStoreID) GetFromAddress = objCDOItem.Sender.Address Set objCDOItem = Nothing End Function Function GetFromDomain(objMsg As MailItem) As String Dim strEntryID As String Dim strStoreID As String Dim objCDOItem As MAPI.Message Dim myAtPos As Integer ' get EntryID and StoreID for message strEntryID = objMsg.EntryID strStoreID = objMsg.Parent.StoreID If G_objSession Is Nothing Then ' Set the CDO Session up as it doesn't exist. Call SetCDOSession End If ' pass item to CDO and get sender address On Error Resume Next Set objCDOItem = G_objSession.GetMessage(strEntryID, strStoreID) If "SMTP" = objCDOItem.Sender.Type Then myAtPos = InStr(1, objCDOItem.Sender.Address, "@", vbTextCompare) + 1 GetFromDomain = Mid(objCDOItem.Sender.Address, myAtPos) Else ' Strip out the Domain from the mail using LDAP format. e.g. /o=LatentZero/ou=Adm..... Strip out LatentZero GetFromDomain = Mid(Left(objCDOItem.Sender.Address, InStr(1, objCDOItem.Sender.Address, "/ou=", vbTextCompare) - 1), 4) End If Set objCDOItem = Nothing End Function Sub SetFromDomain(objMsg As MailItem, strDomain As String) Dim objProp As UserProperty ' Check if the item already has a Domain Property, Get a pointer to the new or existing one If objMsg.UserProperties("Domain") Is Nothing Then Set objProp = objMsg.UserProperties.Add("Domain", olText) Else Set objProp = objMsg.UserProperties("Domain") End If ' If the Item is a mail item, Get the domain, else Report that it isn't a mail item If olMail = objMsg.Class Then objProp.Value = GetFromDomain(objMsg) Else objProp.Value = "Not a Mail Item" End If objMsg.Save End Sub Sub AssignDomain() Dim myExplorer Dim myFolder Dim myItems Dim myMailItem As MailItem Dim Item Set myExplorer = Application.ActiveExplorer ' Get a handle on the windows current folder Set myFolder = myExplorer.CurrentFolder ' Get a collection of all of the messages in the folder Set myItems = myFolder.Items ' For each of the items in the collection get the Domain, if the item is a olMail object. For Each Item In myItems ' If the Item is a mail item, Get the domain, else Report that it isn't a mail item If Item.Class = olMail Then Set myMailItem = Item Call SetFromDomain(myMailItem, GetFromDomain(myMailItem)) Else Call SetFromDomain(myMailItem, "Not a Mail Item") End If Item.Save Next End Sub
All 10comments

	Page [ 1 ]
	Justin 29-Mar-2006 10:22 I have followed the instructions for copying this code to outlook, but how do I run it and then select the domain column??
	Dale Cooper 31-Mar-2006 05:58 I'm sorry for the slow reponse. I am a little rusty on this now as I did it a long time ago. I must warn you that this isn't working for Outlook 2003. Dunno about Outlook XP edition? The work was done for Outlook 2000. But here we go nonetheless. With the VB editor open from outlook ensure that the CDO libraries are being loaded. This is done via Tools->References. If this is already checked all is good. If it isn't then check the field and restart outlook. When Outlook starts you maybe asked f you want to enable Macro's. You need to enable the macros' middle button as I recall..... Before you do this move the contents of you Inbox into a folder somewhere else. Then copy 2 or 3 emails back into the inbox for the purposes of testing. You can test the code is operating by clicking on the Play Button the little right facing triangle.. I think you have to select initialise before any of the others will work. Once control is returned to you you can the use the other options. Typically you will use Assign Domain. If this runs through without errors then all is good. Close the VB Editor and return to outlook. Now right click in the tools bar area of the Outlook window. You should be offered a Customise option. Once you have selected this you are given a pop screen. Select the Commands Tab nd locate the Macro's option, you will find a set of options. AssignDomain, CreateMapping etc. These can be dragged to the tool bar for use by simply clicking on them. I suggest using using only AssignDomain.. Click on the Assign Domain button. THen right click on the columnheadings and choose 'field chooser'. You will need to change the pull down list from Frequently Used Fields to be User Defined Fields, here you will find the Domain column. Drag the Domain Column button from the pop up into the columns of the inbox. I tend to 'Group By' Domain and then by From. I find this the most convenient use. Good Luck
	David Lee Steele, Jr. 22-Jun-2006 18:13 Know of any way to do this for Outlook 2003?
	Dale 23-Jun-2006 03:23 I haven't got 2003. So I have never updated it. Sorry.
	Sue Mosher 29-Jun-2006 14:54 I don't see anything in Dale's code that wouldn't work in Outlook 2003, assuming CDO is installed, of course.
	Dale 30-Jun-2006 03:29 I have had a quick pop at getting this to work. No dice though.....Could simply of been I didn't load the required libraries???Doh! But I think I also recall reading that MS changed some CDO or MAPI calls/availability. As such I pulled the canopy cord and stopped trying.... Chicken that I am.... Good Luck. If anybody get's this working, please let me know.. If I can rustle up access to a copy of O2003 I will try it out. And post the solution
	Ferdinand 18-Sep-2009 04:33 Hi there, In Outlook 2007 again the domain was not included as a standard field by Microsoft. I have looked for this and this seems to be the best solution I have found sofar. But I am using Outlook 2007. Would this code work 'as-is'? In the VBA editor I cannot find the CDO library. Has this been changed/ renamed in 2007? Any help is appreciated. PS: I have nearly 4000 emails in my Inbox. Would this routine still work or lock up Outlook?
	Sue Mosher 18-Sep-2009 08:17 Ferdinand, CDO is not included with Outlook 2007, but is available as a separate download; see http://www.outlookcode.com/article.aspx?id=20 . However, you don't want to use it, because it will trigger security prompts. Instead, just use the MailItem.SenderEmailAddress property from the Outlook object model. How the routine performs against your data is something you'd have to test.
	Ferdinand 05-Nov-2009 07:35 Hello all, Just to let you know the following, and ask an extra question. It turned out we use Outlook 2003 and not 2007. So I just copied everything to the respective part in VBA, but at first it didn't work. Turned out I had not loaded CDO yet, couldn't find it at first but it is listed as 'Microsoft CDO 1.21 Library'. After that everything worked ok, I followed the instructions from Dale Cooper above. As to speed, it took about 4 minutes before the macros had processed all of my 4100 emails. As to functionality: This is what I have been looking for for years! Excellent code. I just can't imagine of any reason why Microsoft has not added this functionality directly in Outlook. And now the extra question: When I run the code I get the message "A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this?" With the option of a single yes, a timed yes or no. However I cannot give it an unlimited yes so every now and then this pops up which is really annoying. I have already digitally signed and trusted my codes, so how do I get rid of this message? Thanks for the help, and thanks to Dale Cooper for the code. Ferdinand
	Sue Mosher 05-Nov-2009 08:22 Ferdinand, digitally signing your code has no effect on the "object model guard" placed on CDO, which will always raise security prompts in Outlook 2003, unless the Exchange administrator specifically allows some operations. See http://www.outlookcode.com/article.aspx?ID=52 for your options.
	Page [ 1 ]

name email

Search Outlook Code