Adding Company Name to Contact Group

[charmise]

Hi All,



I am using Outlook 2010 on a PC. I have contact groups. The contact groups only show the persons name and email. I would like to show the company name in the contact group. I need to do compile a list for a survey and I need the company name. I will export this list to Excel. Any help is much appreciated. Thanks.

[gmayor]

That was an interesting problem that required a little lateral thinking, but the following appears to work. You need to change the items were indicated if necessary. I chose a CSV file as the destination which is much faster than faffing around with Excel, while being Excel compatible. I have not added any error correction so you need to select the Distribution liost and run the macro - once!

Option Explicit
Const strPath As String = "C:\Path\ContactGroup.csv" 'The full name of the CSV file to be created.

Sub GetList()
Dim olNS As NameSpace
Dim olItem As DistListItem
Dim olAddrList As AddressList
Dim olContact As AddressEntry
Dim sContact As String
Dim sName As String
Dim sCompany As String
Dim sAddress As String
Dim i As Long
    sContact = "Company,Name,E-Mail"
    AddToCSV sContact
    Set olNS = GetNamespace("MAPI")
    Set olAddrList = olNS.AddressLists("Contacts") 'The name of the contacts' list

    'On Error Resume Next
    Set olItem = ActiveExplorer.Selection.Item(1)
    For i = 1 To olItem.MemberCount
        sAddress = olItem.GetMember(i).Address
        sName = Replace(Trim(Split(olItem.GetMember(i).Name, "(")(0)), ",", " ")
        Set olContact = olAddrList.AddressEntries(sName)
        sCompany = olContact.GetContact.CompanyName
        AddToCSV sCompany & "," & sName & "," & sAddress
    Next i
    MsgBox strPath & " created"
lbl_Exit:
    Exit Sub
End Sub


Sub AddToCSV(strLine As String)
'Graham Mayor - www.gmayor.com
'strline is the line of text to be added
Dim oFSO As Object
Dim oFile As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.OpenTextFile(strPath, 8, True, 0)
    oFile.Write strLine & vbCrLf
    oFile.Close
lbl_Exit:
    Set oFSO = Nothing
    Set oFile = Nothing
    Exit Sub
End Sub

[Anjlua]

Hi Cahrmise,

Outlook provides many features, exporting is one of those. Using Outlook to export contacts to MS Excel, do these steps:

Start Outlook >> click File >> click Import and Export...
Click Export to a file >> click on Next >> select Microsoft Excel >> click Next
Select Contacts from the folder list >> click Next
Click Browse and provide the location and name of a file to save the contacts as a CSV file format
Click Next >> click Finish.

Note: the time taken to complete the exporting process depends on the size of your contact list.

Thanks & Regards
Anjlua

[gmayor]

Originally Posted by Anjlua

Outlook provides many features, exporting is one of those.

That's all very well, but the requirement was to compile a list of the members of a contact group, with their company names (which are not included in the contact group).