MAPI und Exchange Server, Kontakte auslesen

[PASST]

Hi Borschti,

ich habe dir mal zwei Proceduren zusammengeschrieben, die ich verwende.

Mit ReadOutlookFillTable lese ich Kontakte aus Outlook in eine Tabelle, mit Write2Outlook schreibe ich in den Kontakt hinein. Wobei ich nicht genau weiß ob die Schreibfunktion auch klappt. Habe gesehen, dass ich diese Procedure gar nicht aktiv verwende

Mach dir mal selber ein Bild:

Delphi-Quellcode:

uses ComObj, Variants;

...

procedure TForm1.ReadOutlookFillTable();
const
  olFolderContacts = $0000000A;
var
  outlook, NameSpace, Contacts, Contact: OleVariant;
  i: Integer;
  s: String;
begin

  memTab.emptyTable;

  Outlook := CreateOleObject('Outlook.Application');
  NameSpace := Outlook.GetNameSpace('MAPI');

  // Hier muss der Anwender aktiv den richtigen Ordner auswählen.
  Contacts := NameSpace.PickFolder;

  If (Contacts.Items.Count = 0)
  then lFehler := true
  else
    try
      s := contacts.items.item(1).lastname;
    except
      lFehler := true;
    end;

  if lFehler
  then begin
    showmessage('Es sind keine Kontakte im Ordner ' + Contacts.Name + ' vorhanden.');
    exit;
  end;

  with memTab do
  begin
    open;
    for i := 1 to Contacts.Items.Count do
    begin
      Contact := Contacts.Items.Item(i);
      append;
      fieldbyname('nachname').asstring := Trim(Contact.LastName);
      fieldbyname('vorname').asstring := Trim(Contact.FirstName);
      fieldbyname('firma').asstring := Trim(Contact.CompanyName);
      fieldbyname('abteilung').asstring := Trim(Contact.JobTitle);
      fieldbyname('department').asstring := Trim(Contact.Department);
      fieldbyname('sortabteilung').asstring := Contact.OfficeLocation;
      fieldbyname('ruf1').asstring := Trim(Contact.BusinessTelephoneNumber);
      if (pos('+49 (meine_vorwahl) mein_ortsanschluss', Contact.BusinessTelephoneNumber) <> 0)
      then begin
        s := Copy(Trim(Contact.BusinessTelephoneNumber), 15, 10);
        if pos('-', s) = 1 then fieldbyname('kurz1').asstring := copy(s, 2, length(s));
      end;
      fieldbyname('ruf2').asstring := Trim(Contact.Business2TelephoneNumber);
      if (pos('+49 (meine_vorwahl) mein_ortsanschluss', Contact.Business2TelephoneNumber) <> 0)
      then begin
        s := Copy(Trim(Contact.Business2TelephoneNumber), 15, 10);
        if pos('-', s) = 1 then fieldbyname('kurz2').asstring := copy(s, 2, length(s));
      end;
      fieldbyname('hotline').asstring := Trim(Contact.CompanyMainTelephoneNumber);
      fieldbyname('fax').asstring := Trim(Contact.BusinessFaxNumber);
      if (pos('+49 (meine_vorwahl) mein_ortsanschluss', Contact.BusinessFaxNumber) <> 0)
      then begin
        s := Copy(Trim(Contact.BusinessFaxNumber), 15, 10);
        if pos('-', s) = 1 then fieldbyname('faxkurz').asstring := copy(s, 2, length(s));
      end;
      fieldbyname('mobil').asstring := Trim(Contact.MobileTelephoneNumber);
      if (pos('+49 (meine_handy_vorwahl) meine_handyvpngruppe', Contact.MobileTelephoneNumber) <> 0)
      then
        fieldbyname('mobilkurz').asstring := Copy(Trim(Contact.MobileTelephoneNumber), 15, 10);

      // Outlook unterscheidet für die Emailadresse (mind.) zwei Formate:
      // die übliche SMTP oder für EX einen Exchange-User im X400-Format
      if Trim(Contact.Email1AddressType) = 'SMTP'
      then
        fieldbyname('email1').asstring := Trim(Contact.Email1Address)
      else if Trim(Contact.Email1AddressType) = 'EX'
      then begin
        fieldbyname('email1').asstring := Trim(copy(Contact.Email1DisplayName,
                                                    pos('(', Contact.Email1DisplayName) +1,
                                                    length(Contact.Email1DisplayName) - pos('(', Contact.Email1DisplayName) -1
                                                    ));
      end;
     
     ...diverses...Zeugs...
     
      post;
    end;  // for i..
    first;
  end; // with memTab

  Outlook := Unassigned;
end;



procedure TForm1.Write2Outlook();
type
  TAbteilung = Array [1..20] of String;
const
  olFolderContacts = $0000000A;
var
  outlook, NameSpace, Contacts, Contact: OleVariant;
  i, j: Integer;
  aAbt: TAbteilung;
begin

  // Die Reihenfolge der Element gibt nachher die Sortierung im Ausdruck vor.
  aAbt[1]  := 'Ein_Abteilungsname';
  aAbt[2]  := 'Noch_ein_Abteilungsname';
  aAbt[3]  := '...';
  ...

  Outlook := CreateOleObject('Outlook.Application');
  NameSpace := Outlook.GetNameSpace('MAPI');
  Contacts := NameSpace.GetDefaultFolder(olFolderContacts).Folders.Item('Firma');
  for i := 1 to Contacts.Items.Count do
  begin
    Contact := Contacts.Items.Item(i);

    if Trim(Contact.JobTitle) = ''
    then begin
      Contact.JobTitle := Trim(Contact.JobTitle);
      Contact.OfficeLocation := '99';
      Contact.Save;
    end
    else begin

      for j := 1 to length(aAbt) do
      begin
        if Trim(Contact.JobTitle) = aAbt[j]
        then begin
          Contact.JobTitle := Trim(Contact.JobTitle);
          if (j < 10)
          then
            Contact.OfficeLocation := '0' + inttostr(j)
          else
            Contact.OfficeLocation := inttostr(j);
          Contact.Save;
          // Schleife abbrechen brauche nicht weitersuchen!
          break;
        end;
      end; // for j..

    end; // if trim(..) else

  end; // for i..
  Outlook := Unassigned;

end;