Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как прочитать адресную книгу Outlook (MSOffice) из Delphi и занести данные в таблицу *.db?

01.01.2007

Сперва сделай 'Import type Library' для Outlk80.olb, (расположен в \Program Files\Microsoft Office\Office).

После того, как появится файл 'Outlook_TLB.pas', можно нацарапать следующее:

uses ComObj, Outlook_TLB;procedure TForm1.Button1Click(Sender: TObject);var  MSOutlook,  MyNameSpace, 
 MyFolder,  MyItem: Variant;  s: string;  i: Integer;begin  try    MSOutlook := CreateOleObject('Outlook.Application');  
   MyNameSpace := MSOutlook.GetNameSpace('MAPI');    MyFolder := MyNamespace.GetDefaultFolder(olFolderContacts);  
     for i := 1 to MyFolder.Items.Count do 
begin
      s := s + #13#13'Contact No: ' + IntToStr(i) + #13#13; 
     MyItem := MyFolder.Items[i];
      s := s + 'BillingInformation: ' + MyItem.BillingInformation + #13;
      s := s + 'Body: ' + MyItem.Body + #13;      s := s + 'Categories: ' + MyItem.Categories + #13;  
    s := s + 'Companies: ' + MyItem.Companies + #13;      s := s + 'CreationTime: ' + DateTimeToStr(MyItem.CreationTime) + #13;
      s := s + 'EntryID: ' + MyItem.EntryID + #13;      s := s + 'Importance: ' + IntToStr(MyItem.Importance) + #13;
      s := s + 'LastModificationTime: ' + DateTimeToStr(MyItem.LastModificationTime) + #13;
      s := s + 'MessageClass: ' + MyItem.MessageClass + #13;      s := s + 'Mileage: ' + MyItem.Mileage + #13;
      s := s + 'NoAging: ' + IntToStr(MyItem.NoAging) + #13;      s := s + 'OutlookVersion: ' + MyItem.OutlookVersion + #13; 
     s := s + 'Saved: ' + IntToStr(MyItem.Saved) + #13;      s := s + 'Sensitivity: ' + IntToStr(MyItem.Sensitivity) + #13;
      s := s + 'Size: ' + IntToStr(MyItem.Size) + #13;      s := s + 'Subject: ' + MyItem.Subject + #13; 
     s := s + 'UnRead: ' + IntToStr(MyItem.UnRead) + #13;      s := s + 'Account: ' + MyItem.Account + #13; 
     s := s + 'Anniversary: ' + DateTimeToStr(MyItem.Anniversary) + #13;   
   s := s + 'AssistantName: ' + MyItem.AssistantName + #13; 
     s := s + 'AssistantTelephoneNumber: ' + MyItem.AssistantTelephoneNumber + #13;
      s := s + 'Birthday: ' + DateTimeToStr(MyItem.Birthday) + #13; 
     s := s + 'Business2TelephoneNumber: ' + MyItem.Business2TelephoneNumber + #13;  
    s := s + 'BusinessAddress: ' + MyItem.BusinessAddress + #13; 
     s := s + 'BusinessAddressCity: ' + MyItem.BusinessAddressCity + #13;   
   s := s + 'BusinessAddressCountry: ' + MyItem.BusinessAddressCountry + #13;
      s := s + 'BusinessAddressPostalCode: ' + MyItem.BusinessAddressPostalCode + #13; 
     s := s + 'BusinessAddressPostOfficeBox: ' + MyItem.BusinessAddressPostOfficeBox + #13;
      s := s + 'BusinessAddressState: ' + MyItem.BusinessAddressState + #13;
      s := s + 'BusinessAddressStreet: ' + MyItem.BusinessAddressStreet + #13; 
     s := s + 'BusinessFaxNumber: ' + MyItem.BusinessFaxNumber + #13;
      s := s + 'BusinessHomePage: ' + MyItem.BusinessHomePage + #13; 
     s := s + 'BusinessTelephoneNumber: ' + MyItem.BusinessTelephoneNumber + #13; 
     s := s + 'CallbackTelephoneNumber: ' + MyItem.CallbackTelephoneNumber + #13; 
     s := s + 'CarTelephoneNumber: ' + MyItem.CarTelephoneNumber + #13;
      s := s + 'Children: ' + MyItem.Children + #13;  
    s := s + 'CompanyAndFullName: ' + MyItem.CompanyAndFullName + #13;
      s := s + 'CompanyMainTelephoneNumber: ' + MyItem.CompanyMainTelephoneNumber + #13; 
     s := s + 'CompanyName: ' + MyItem.CompanyName + #13; 
     s := s + 'ComputerNetworkName: ' + MyItem.ComputerNetworkName + #13; 
     s := s + 'CustomerID: ' + MyItem.CustomerID + #13;
      s := s + 'Department: ' + MyItem.Department + #13; 
    s := s + 'Email1Address: ' + MyItem.Email1Address + #13;
     s := s + 'Email1AddressType: ' + MyItem.Email1AddressType + #13;
      s := s + 'Email1DisplayName: ' + MyItem.Email1DisplayName + #13;
      s := s + 'Email1EntryID: ' + MyItem.Email1EntryID + #13; 
     s := s + 'Email2Address: ' + MyItem.Email2Address + #13;
      s := s + 'Email2AddressType: ' + MyItem.Email2AddressType + #13; 
     s := s + 'Email2DisplayName: ' + MyItem.Email2DisplayName + #13;
      s := s + 'Email2EntryID: ' + MyItem.Email2EntryID + #13;
     s := s + 'Email3Address: ' + MyItem.Email3Address + #13;  
    s := s + 'Email3AddressType: ' + MyItem.Email3AddressType + #13; 
     s := s + 'Email3DisplayName: ' + MyItem.Email3DisplayName + #13;
      s := s + 'Email3EntryID: ' + MyItem.Email3EntryID + #13;
      s := s + 'FileAs: ' + MyItem.FileAs + #13; 
    s := s + 'FirstName: ' + MyItem.FirstName + #13;  
    s := s + 'FTPSite: ' + MyItem.FTPSite + #13; 
     s := s + 'FullName: ' + MyItem.FullName + #13; 
    s := s + 'FullNameAndCompany: ' + MyItem.FullNameAndCompany + #13;
      s := s + 'Gender: ' + IntToStr(MyItem.Gender) + #13;
      s := s + 'GovernmentIDNumber: ' + MyItem.GovernmentIDNumber + #13;
                s := s + 'Hobby: ' + MyItem.Hobby + #13; 
     s := s + 'Home2TelephoneNumber: ' + MyItem.Home2TelephoneNumber + #13; 
     s := s + 'HomeAddress: ' + MyItem.HomeAddress + #13; 
     s := s + 'HomeAddressCity: ' + MyItem.HomeAddressCity + #13; 
     s := s + 'HomeAddressCountry: ' + MyItem.HomeAddressCountry + #13; 
     s := s + 'HomeAddressPostalCode: ' + MyItem.HomeAddressPostalCode + #13;
      s := s + 'HomeAddressPostOfficeBox: ' + MyItem.HomeAddressPostOfficeBox + #13; 
     s := s + 'HomeAddressState: ' + MyItem.HomeAddressState + #13;
      s := s + 'HomeAddressStreet: ' + MyItem.HomeAddressStreet + #13;  
    s := s + 'HomeFaxNumber: ' + MyItem.HomeFaxNumber + #13;  
    s := s + 'HomeTelephoneNumber: ' + MyItem.HomeTelephoneNumber + #13;
      s := s + 'Initials: ' + MyItem.Initials + #13;
     s := s + 'ISDNNumber: ' + MyItem.ISDNNumber + #13;  
    s := s + 'JobTitle: ' + MyItem.JobTitle + #13; 
     s := s + 'Journal: ' + IntToStr(MyItem.Journal) + #13; 
     s := s + 'Language: ' + MyItem.Language + #13; 
     s := s + 'LastName: ' + MyItem.LastName + #13;  
    s := s + 'LastNameAndFirstName: ' + MyItem.LastNameAndFirstName + #13; 
     s := s + 'MailingAddress: ' + MyItem.MailingAddress + #13;
     s := s + 'MailingAddressCity: ' + MyItem.MailingAddressCity + #13; 
     s := s + 'MailingAddressCountry: ' + MyItem.MailingAddressCountry + #13; 
     s := s + 'MailingAddressPostalCode: ' + MyItem.MailingAddressPostalCode + #13;
      s := s + 'MailingAddressPostOfficeBox: ' + MyItem.MailingAddressPostOfficeBox + #13;
      s := s + 'MailingAddressState: ' + MyItem.MailingAddressState + #13;
      s := s + 'MailingAddressStreet: ' + MyItem.MailingAddressStreet + #13;  
    s := s + 'ManagerName: ' + MyItem.ManagerName + #13;
      s := s + 'MiddleName: ' + MyItem.MiddleName + #13; 
     s := s + 'MobileTelephoneNumber: ' + MyItem.MobileTelephoneNumber + #13; 
     s := s + 'NickName: ' + MyItem.NickName + #13; 
     s := s + 'OfficeLocation: ' + MyItem.OfficeLocation + #13;
      s := s + 'OrganizationalIDNumber: ' + MyItem.OrganizationalIDNumber + #13; 
     s := s + 'OtherAddress: ' + MyItem.OtherAddress + #13; 
     s := s + 'OtherAddressCity: ' + MyItem.OtherAddressCity + #13;  
    s := s + 'OtherAddressCountry: ' + MyItem.OtherAddressCountry + #13;
      s := s + 'OtherAddressPostalCode: ' + MyItem.OtherAddressPostalCode + #13;
      s := s + 'OtherAddressPostOfficeBox: ' + MyItem.OtherAddressPostOfficeBox + #13; 
     s := s + 'OtherAddressState: ' + MyItem.OtherAddressState + #13;
      s := s + 'OtherAddressStreet: ' + MyItem.OtherAddressStreet + #13; 
     s := s + 'OtherFaxNumber: ' + MyItem.OtherFaxNumber + #13; 
     s := s + 'OtherTelephoneNumber: ' + MyItem.OtherTelephoneNumber + #13;
      s := s + 'PagerNumber: ' + MyItem.PagerNumber + #13;
      s := s + 'PersonalHomePage: ' + MyItem.PersonalHomePage + #13; 
     s := s + 'PrimaryTelephoneNumber: ' + MyItem.PrimaryTelephoneNumber + #13;
      s := s + 'Profession: ' + MyItem.Profession + #13;
      s := s + 'RadioTelephoneNumber: ' + MyItem.RadioTelephoneNumber + #13;
      s := s + 'ReferredBy: ' + MyItem.ReferredBy + #13;
      s := s + 'SelectedMailingAddress: ' + In      s := s + 'Spouse: ' + MyItem.Spouse + #13;      s := s + 'Suffix: ' + MyItem.Suffix + #13; 
     s := s + 'TelexNumber: ' + MyItem.TelexNumber + #13;      s := s + 'Title: ' + MyItem.Title + #13; 
     s := s + 'TTYTDDTelephoneNumber: ' + MyItem.TTYTDDTelephoneNumber + #13; 
     s := s + 'User1: ' + MyItem.User1 + #13;      s := s + 'User2: ' + MyItem.User2 + #13; 
     s := s + 'User3: ' + MyItem.User3 + #13;      s := s + 'User4: ' + MyItem.User4 + #13; 
     s := s + 'UserCertificate: ' + MyItem.UserCertificate + #13;
      s := s + 'WebPage: ' + MyItem.WebPage + #13;
  end; 
   Memo1.Lines.Text := s;  except    on 
E: Exception do MessageDlg(E.Message + #13 + s, mtError, [mbOk], 0)
  end;  MSOutlook.Quit;
end;

Взято с сайта https://blackman.wp-club.net/