Retrieving outlook contact emails

[Connie McBride 0]

I'm trying to figure out how to retrieve the contacts from outlook from a specific list.

for example, I have been able to get the address lists:

 

 

and now I want to select one of those items (offline global address list, for instance) and get all the contacts/emails from that specific list.

I am having no luck working that part out.

 

any help?

 

 

[Pat Foley 54]

One way is save as .pst file or .csv file inside of Outlook.

 

Second way is use VBA to learn the names of methods that Outlook uses to save lists in different formats.    

[Die Holländer 90]

I found some old code to retrieve the list of a group, like "Global Address List"

The code here is based on to put the addresses in a TreeView.

 

I checked the code and it is still running OK but I noticed that I don't see the e-mail addresses

anymore but instead it reports a string like: "/o=ExchangeLabs/ou=....."

Maybe this is because of the exchange server configuration in my environment.

 

see: how-to-get-email-address-from-o-exchangelabs-ou-exchange-administrative-group

 

You have to play with it to see if you get the proper info you want.

Maybe you can post the final answer here if you find the proper addresses..

 

Note that the code has a filter to only show two groups:

If (CurGroupName='All Groups') or (CurGroupName='Global Address List')  Then...

 

//Uses Outlook2000;

Procedure TMailTrans.CreateGALTreeForSendMailItem(aTreeView : TTreeView);
Var pProp : PSPropValue;
    MP : IMAPIProp;
    strAddress : String;
    i, j, Check: Integer;
    myAddressList: AddressList;
    myAddressLists: AddressLists;
    myAddressEntries: AddressEntries;
    myAddressEntry: AddressEntry;
    CurNode, ChildNode, DetailNode :TTreeNode;
    CurGroupName : String;
begin
  If NmSpace=NIL Then
  Begin
    OutlookApplication1.Connect;
    NmSpace:=OutlookApplication1.GetNamespace('MAPI');
    NmSpace.Logon('', '', False, False);
  End;

  myAddressLists := IUnknown(NmSpace.AddressLists) as AddressLists;
  aTreeView.Items.BeginUpdate;
  aTreeView.Items.Clear;

  for i := 1 to myAddressLists.Count do
  begin
    CurGroupName:=myAddressLists.Item(i).Name;
    If (CurGroupName='All Groups') or
       (CurGroupName='Global Address List')  Then
    Begin
      CurNode:=aTreeView.Items.Add(Nil,myAddressLists.Item(i).Name);
      CurNode.ImageIndex:=2;
      CurNode.SelectedIndex:=2;

      myAddressList := myAddressLists.Item(i);
      if Assigned(myAddressList.AddressEntries) then
      Begin
        myAddressEntries := myAddressList.AddressEntries;
        for j := 1 to myAddressEntries.Count do
        begin
          strAddress:='Unknown';
          myAddressEntry := myAddressEntries.Item(j);

          if Assigned(myAddressEntry) then
          Begin
            if myAddressEntry.MAPIOBJECT<>NIL then
            Begin
              if Assigned(myAddressEntry.MAPIOBJECT) then
              Begin
                {
                Check:=IUnknown(myAddressEntry.MAPIOBJECT).QueryInterface(IMailUser,MP);
                If Check=0 then MP:=IUnknown(myAddressEntry.MAPIOBJECT) as IMailUser
                else MP:= IUnknown(myAddressEntry.MAPIOBJECT) as IDistList;

                if S_OK = HrGetOneProp(MP, $39FE001E, pProp) then
                begin
                  strAddress:=String(pProp.Value.lpszA);
                  MAPIFreeBuffer(pProp);
                end; // else strAddress:=myAddressEntry.Address;
                }
                strAddress:=myAddressEntry.Address;

                ChildNode:=aTreeView.Items.AddChild(
                          CurNode,
                          myAddressEntry.Name);

                ChildNode.ImageIndex:=7;
                ChildNode.SelectedIndex:=7;

                DetailNode:=aTreeView.Items.AddChild(
                          ChildNode,
                          strAddress);
                DetailNode.ImageIndex:=6;
                DetailNode.SelectedIndex:=6;
              End;
            End;

            {
            DetailNode:=aTreeView.Items.AddChild(
                      ChildNode,
                      myAddressEntry.Address);
            DetailNode.ImageIndex:=6;
            DetailNode.SelectedIndex:=6;
            }
          End;
        End;
      End;
    end;
    //Application.Processmessages;
  end;
  aTreeView.Items.EndUpdate;
end;

 

Edited June 18 by Die Holländer

[Connie McBride 0]

I've gotten partway there, but not quite.

the contacts are coming back as nothing, though I am able to put the names into the list.

my code:

// Add the names of all address entries for the specified Book into AddrList
procedure TContactOutlook.GetAddresses(Book: string; AddrList: TStrings);
var
   i: Integer;
   EmailAddress: string;
   NameSpace: OLEVariant;
   aClass : integer;
   aName : string;
   addList: AddressList;
   addrLists: AddressLists;
   addrEntries : AddressEntries;
   addrEntry : addressEntry;
   Contacts: OLEVariant;
   Contact: ContactItem;
   grpName : string;
   j : integer;
   aLine : string;
begin
   Screen.Cursor := crHourGlass;
   if not FOutlookActive then
      StartOutlook;
   AddrList.Clear;
 // Access the MAPI namespace
   NameSpace := FOutlookApp.GetNamespace('MAPI');
   addrLists := IUnknown(NameSpace.AddressLists) as AddressLists;
   for i := 1 to addrLists.Count do
   begin
      grpName := addrLists.Item(i).Name;
      if grpName = book then
      begin
   // Cycle through all address entries and add the name of each one to AddrList
         addList := addrLists.Item(i);
         if assigned(addList.AddressEntries) then
         begin
            addrEntries := addList.AddressEntries;
            contacts := addList.GetContactsFolder;
            if not varIsClear(contacts) then  //this is never set to anything
            begin
            // Cycle through all address entries and add the name of each one to AddrList
               for j := 1 to Contacts.Items.count do
               begin
                  contact := IUnknown(contacts.items(j)) as ContactItem;
                  aClass := contact.Class_;
                  aName := contact.FullName;
                  if aClass <> 69 then
                  begin
                     emailAddress := contact.Email1Address;
                     if (emailAddress <> '') then
                     begin
                        aLine := contact.FullName + '<' + emailAddress + '>';
                        if addrList.IndexOf(aLine) = -1 then
                           AddrList.Add(aLine);
                     end;
                     emailAddress := contact.email2Address;
                     if (emailAddress <> '') then
                     begin
                        aLine := contact.FullName + '<' + emailAddress + '>';
                        if addrList.IndexOf(aLine) = -1 then
                           AddrList.Add(aLine);
                     end;
                     emailAddress := contact.email3Address;
                     if (emailAddress <> '') then
                     begin
                        aLine := contact.FullName + '<' + emailAddress + '>';
                        if addrList.IndexOf(aLine) = -1 then
                           AddrList.Add(aLine);
                     end;

                  end;
               end;
            end;

            for j := 1 to addrEntries.Count do
            begin
               addrEntry := addrEntries.Item(j);
               if assigned(addrEntry) then
               begin
                  aName := addrEntry.Name;
                  contact := addrEntry.GetContact;//this also never returns anything
                  if not varIsClear(contact) then
                  begin
                     aClass := contact.Class_;
                     aName := contact.FullName;
                     if aClass <> 69 then
                     begin
                        emailAddress := contact.Email1Address;
                        if (emailAddress <> '') then
                        begin
                           aLine := contact.FullName + '<' + emailAddress + '>';
                           if addrList.IndexOf(aLine) = -1 then
                              AddrList.Add(aLine);
                        end;
                        emailAddress := contact.email2Address;
                        if (emailAddress <> '') then
                        begin
                           aLine := contact.FullName + '<' + emailAddress + '>';
                           if addrList.IndexOf(aLine) = -1 then
                              AddrList.Add(aLine);
                        end;
                        emailAddress := contact.email3Address;
                        if (emailAddress <> '') then
                        begin
                           aLine := contact.FullName + '<' + emailAddress + '>';
                           if addrList.IndexOf(aLine) = -1 then
                              AddrList.Add(aLine);
                        end;
                     end;
                  end
                  else
                     if addrList.indexOf(aName) = -1 then
                        addrList.Add(aName);
               end;
            end;
         end;
      end;
   end;
   Screen.Cursor := crDefault;
   if debugOn  then
      addrList.SaveTofile('address.txt');

end;

 

[Pat Foley 54]

Again I would use OutLook to make the output using export.

 

example mapping

https://jkp-ads.com/rdb/win/s1/outlook/mail.htm

 

Also here is some old (2017) Excel code from Ron's earlier site 

Sub DemoAE()
    Dim colAL As Outlook.AddressLists
    Dim oAL As Outlook.AddressList
    Dim colAE As Outlook.AddressEntries
    Dim oAE As Outlook.AddressEntry
    Dim oExUser As Outlook.ExchangeUser
    Set colAL = Outlook.session.AddressLists '("Offline Global Address List")
    For Each oAL In colAL
        'Address list is an Exchange Global Address List
        If oAL.AddressListType = olExchangeGlobalAddressList Then
            Set colAE = oAL.AddressEntries
            For Each oAE In colAE
                If oAE.AddressEntryUserType = _
                    olExchangeUserAddressEntry _
                    Or oAE.AddressEntryUserType = _
                    olExchangeRemoteUserAddressEntry Then
                    Set oExUser = oAE.GetExchangeUser
                   ' Debug.Print (oExUser.JobTitle)
                   ' Debug.Print (oExUser.OfficeLocation)
                  '  Debug.Print (oExUser.BusinessTelephoneNumber)
                   ' Range("A1").Offset(X, 1) = oExUser.JobTitle
                    Range("A1").Offset(X, 9) = oExUser.ID
                    'OfficeLocation
                    Range("A1").Offset(X, 8) = oExUser.MobileTelephoneNumber
                    'HomeTelephoneNumber
                    Range("A1").Offset(X, 7) = oExUser.Name
                    'Range("A1").Offset(X, 5) = oExUser.PrimarySmtpAddress
                    
                    X = X + 1
                End If
            Next
        End If
    Next
End Sub

  

[Connie McBride 0]

right.  except the users want to click a button and access the addresses live.  Wouldn't exporting them require an extra step for the user? 

 

this code is helpful.

does this part: 

Set oExUser = oAE.GetExchangeUser

limit the email addresses to those part of the exchange (in house, vs the contacts, who is their list of clients)?

 

[Pat Foley 54]

I used the code for reverse phone lookup that's for an xxx with xx,xxx outlook accounts.    

 

You need to make a custom list of clients, a Client group email and ... then as employees come and go you add remove their access to the companies Client email account.    

 

Or you could enhance your application by logging when clients are added, contacted, removed from client list.  I sent out emails and SMS each week to departments as client schedules were updated.  

Edited June 19 by Pat Foley
further scheme enhancements