VPF::Как прочитать адресную книгу Outlook (MSOffice)

dobrikovdv

Дата 21.2.2006, 15:56 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 13.1.2006

Репутация: нет
Всего: нет

Умные люди помогите пожалуйста.

Надо что бы при наборе ФИО в ComboBox проходил по Адресной книги Outlook 2003
Как это сделать??

p.s. Outlook установлен, домен настроен и все такое.G

Ozzя

Дата 21.2.2006, 15:59 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 86
Регистрация: 19.7.2004

Репутация: нет
Всего: 1

Взято из ДРКБ

Код



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

      
  

Сперва сделай '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; 

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

dobrikovdv

Дата 21.2.2006, 16:04 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 13.1.2006

Репутация: нет
Всего: нет

2Ozzя глядел я эту ссылку, только че-то так нифига и не понял.

Дайте кто-нить разъяснения, а то че-то не соображаю уже

Albinos_x

Дата 21.2.2006, 17:50 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 15
Всего: 108

есть для этого компанента на вкладке servers - OutlookApplication1

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

dobrikovdv

Дата 21.2.2006, 17:59 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 13.1.2006

Репутация: нет
Всего: нет

Цитата(Albinos_x @ 21.2.2006, 17:50)

есть для этого компанента на вкладке servers - OutlookApplication1

переложил ее на форму, а дальше что делать???

p.s. Может быть не совсем понятно объяснил, но я хочу чтобы:
при введении в ComboBox ФИО, например Иванов у меня в нем начался поиск ФИО в адресной книге Outlook 2003. Ессно если она там есть, то она вывеласть полностью.
Кто хоть раз запускал адресную книгу и осущесвлял там поиск тот должен понять

Albinos_x

Дата 21.2.2006, 19:06 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 15
Всего: 108

я этой Outlook-ом ни разу не пользовался... поэтому как она устроена не знаю... посмотри здесь:
http://forum.vingrad.ru/index.php?showtopi...&hl=outlook
http://forum.vingrad.ru/index.php?showtopi...&hl=outlook
http://forum.vingrad.ru/index.php?showtopi...&hl=outlook
http://forum.vingrad.ru/index.php?showtopi...&hl=outlook

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

dobrikovdv

Дата 22.2.2006, 17:02 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 13.1.2006

Репутация: нет
Всего: нет

E: Exception do MessageDlg(E.Message + #13 + s, mtError, [mbOk], 0)

эта строка не совсем понятна, кто-инбудь может объяснить?

Albinos_x

Дата 22.2.2006, 17:07 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 15
Всего: 108

это вывод сообщения об ошибке

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

dobrikovdv

Дата 22.2.2006, 17:41 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 13.1.2006

Репутация: нет
Всего: нет

Код


procedure TForm1.ComboBox3Change(Sender: TObject);
var
 MyItem : Variant;
 s: String;
 i: Integer;
begin
  MSOutlook := CreateOleObject('Outlook.Application');
  MyNameSpace := MSOutlook.GetNameSpace('MAPI');
  MyFolder := MyNameSpace.GetDefaultFolder(olFolderContacts);
  for i := 1 to MyFolder.Items.Count do
    begin
    s:=s+''+IntToStr(i);
    MyItem:=MyFolder.Items.Item(i);
    s:=s+''+MyItem.FullName;
    end;
Form1.ComboBox3.Text:=s;
MSOutlook := UnAssigned;
end;
end.

накидал это, но почему-то читает из Outlook`а Список контактов, а не адресную книгу!?
Кто-нить знает как исправить ситуацию???

Albinos_x

Дата 22.2.2006, 19:31 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 15
Всего: 108

Цитата(dobrikovdv @ 22.2.2006, 17:41

)

s:=s+''+MyItem.FullName;

попробуй
заменить на:

Код


    s:=s+' '+MyItem.Email1Address+' / '+MyItem.BusinessAddress;

Это сообщение отредактировал(а) Albinos_x - 22.2.2006, 19:34

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

dobrikovdv

Дата 24.2.2006, 15:08 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 13.1.2006

Репутация: нет
Всего: нет

Цитата(Albinos_x @ 22.2.2006, 19:31)

Цитата(dobrikovdv @ 22.2.2006, 17:41

)

s:=s+''+MyItem.FullName;

попробуй
заменить на:

Код


    s:=s+' '+MyItem.Email1Address+' / '+MyItem.BusinessAddress;

заменил, выдает не то smile

вот что выдает: 1 /o=HantosOrg/ou=First Administrative Group/cn=Recipients/cn=DobrikovDV / 34-920

Albinos_x

Дата 24.2.2006, 20:01 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 15
Всего: 108

вот что говорит статья по VBA:

Код


Подключение к папке Контакты Microsoft Outlook 

Работа пользователя, использующего ваше приложение, будет еще эффективнее, если программа будет сама получать список абонентов из папки Контакты Microsoft Outlook и предоставлять его в удобном для использовании виде. Сложного ничего в этом нет, поэтому начнем программировать. Надеюсь, что с подходящим интерфейсом списка вы справитесь сами. 

Получаем объект Outlook: 

lngRetVal = FindWindowByClass("rctrl_renwnd32", 0&)

If lngRetVal <> 0 Then
    Set myOlApp = GetObject(, "Outlook.Application")
Else
   Set myOlApp = CreateObject("Outlook.Application")
End If
- это все также как и раньше. 

dim myNameSpace As Object
dim myfolder As Object

'получаем хранилище сообщений MAPI. 
Set myNameSpace = myOlApp.GetNamespace("MAPI") 
Грубо говоря, все папки Outlook (входящие, отправленные, черновики и так далее), - это хранилище MAPI. 

'получаем папку Контакты из хранилища сообщений MAPI. 
Set myfolder = myNameSpace.GetDefaultFolder(olFolderContacts)

Dim i As Long
'перебираем папку Контакты и читаем нужные нам сведения
For i = 1 To myfolder.Items.Count ' цикл по всем записям в папке
    Me.ListBox1.AddItem (myfolder.Items(i)) 'заполняем ListBox
    Me.ListBox1.List(i - 1, 1) = myfolder.Items(i).Email1Address
    Me.ListBox1.List(i - 1, 2) = myfolder.Items(i).BusinessAddress
Next i
У каждого объекта папки Контакты огромное количество различных свойств. Их полное описание ищите в справочной системе. Я ограничился лишь тремя: название объекта (читай "наименование"), первый E-mail (читай основной), город и основного адреса (читай "рабочего"). В принципе - это все! Естественно перед тем как получить доступ к папке Контакты придется ответить на соответствующее предупреждающее сообщение. Если обращение к папке Контакты в процессе работы происходит часто, то каждый раз отвечать на вопросы безопасности неудобно. Здесь на помощь приходит возможность использования динамических массивов. 

Создаем глобальный массив: 

Public klients()
ReDim klients(myfolder.Items.Count, 3) 'выделяем память
klients = Me.ListBox1.List() 'заполняем массив данными
Обратите внимание, насколько просто скопировать информацию в массив из ListBox. 

Теперь в случае, если пользователь снова обратиться к адресной книге (папке Контакты), то вместо фактической информации можно подставить информацию из массива: 

Me.ListBox1.List() = klients
Снова обратите внимание, - насколько все просто. 

Естественно, содержимое папки Контакты может измениться и содержимое массива, в таком случае, не будет отражать фактическое положение дел. Следует отметить, что содержимое папки Контакты меняется не так уж и часто, но рекомендую предусмотреть кнопку, нажатие на которую вызывает обновление информации в массиве. 

Массив, вообще, отбирая дополнительную, часто драгоценную память, работает в несколько десятков раз быстрее, чем непосредственный доступ к папке Контакты Microsoft Outlook и не вызывает активизации системы безопасности, что делает его применение крайне удобно. В конце следует закрыть сеансы Outlook 

Set objMail = Nothing
Set mailApp = Nothing

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Albinos_x

Дата 6.3.2006, 00:50 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 15
Всего: 108

вот здесь ещё посмотри: http://forum.vingrad.ru/index.php?act=modu...amp;section=794

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: ActiveX/СОМ/CORBA \| Следующая тема »