Данные из Outlook, как достать? :) Опции

[striker]

Нужно достать из аутлука в текстовый файл некоторые данные, а именно: кому,от кого, время отправления, первая строка письма

Т.е программа должна это делать. Как из него вытащить информацию?

[volvo]

"DRKB -> ActiveX, COM и Другие технологии -> Работа с приложениями Microsoft Office -> Работа с Microsoft Outlook" смотрел? Там есть информация о работе с MS Outlook

[striker]

Единственное пока что там нашёл это как считать адрес отправителя:

Код

var
s: string;
objCDO: OLEVariant;
begin
  objCDO := CreateOLEObject('MAPI.Session');
  objCDO.Logon('', '', False, False);
  objMsg := objCDO.GetMessage(itemOL.EntryID, itemOL.Parent.StoreID);

  s := objMsg.Sender.Address;
  ShowMessage(s);
  objMsg := Unassigned;
  objCDO := Unassigned;
end

И то не особо понятно. Может у меня версия старая?
Или где ещё глянуть?

[volvo]

Ну, проверить я ничего связанного с MS Outlook не могу. Я не пользуюсь им просто (он даже не установлен на моем компьютере), у меня другой клиент. Так что подождем того, кто пользуется именно Аутлуком...

[volvo]

Так... Нашел компьютер с Аутлуком и Дельфи одновременно... Уточни, чего именно тебе надо получить? Информацию об Исходящих, или Входящих? Вот это:

procedure TForm1.Button1Click(Sender: TObject);
var
  ns:_NameSpace;
  fld:MAPIFolder;
  im:Variant;
  i:Integer;
begin
  OutlookApplication1.Connect;
  ns := OutlookApplication1.GetNamespace('MAPI');
  ns.Logon(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
  fld:=ns.GetDefaultFolder(olFolderInbox);
  for i:=1 to fld.Items.Count do
  begin
    im := fld.Items.Item(i);
    Memo1.Lines.Add(Format('Письмо №%d', [i]));
    Memo1.Lines.Add('Отправитель: ' + im.SenderName);
    Memo1.Lines.Add('Кому: ' + im.To);
    Memo1.Lines.Add('Текст письма: ' + im.Body);
  end;
  ns.Logoff;
  OutlookApplication1.Disconnect;
  OutlookApplication1.Quit;
end;

Получает информацию обо всех входящих письмах, включая и текст письма. На форме - TMemo + TButton + TOutlookApplication (вкладка Servers), проверено в D2007 + WinXP + Office XP

[striker]

Я тоже Аутлуком не пользуюсь и не пользовался никогда, знаю что это такое и всё
В куске этого кода начало для меня вообще темный лес, синхронизация как я понимаю

Мне нужно сбросить в текстовый файл информацию из выбранного письма (вот тоже как сделать )
Письмо может быть 2х типов: входящее, исходящее. Наверное, нужно будет 2 кнопочки сделать
Из исходящего поля: кому, время отправления, первая строка письма
Из входящего: от кого, время отправления, первая строка письма
Т.е пользователь выбирает письмо и тыкает на кнопочку в зависимости от его типа, так, наверное, получится, удобнее никак скорее всего.
Спасибо, буду рад если ещё чем-нибудь поможешь

[striker]

volvo, больше ничего не нашёл?

[Unconnected]

Так Volvo тебе уже подсказал всё, что нужно:)

Немного модифицировал вышеприведённый код, добавил только вывод в текстовый файл. Сразу говорю, не проверял, т.к. дельфи нет пока, но вроде всё верно.

procedure TForm1.Button1Click(Sender: TObject);
var
  ns:_NameSpace;
  fld:MAPIFolder;
  im:Variant;
  i:Integer;
  f:textfile;
begin
  assignfile(f,'output.txt');
  rewrite(f);
  OutlookApplication1.Connect;
  ns := OutlookApplication1.GetNamespace('MAPI');
  ns.Logon(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
  fld:=ns.GetDefaultFolder(olFolderInbox);
  for i:=1 to fld.Items.Count do
  begin
    im := fld.Items.Item(i);
    writeln(f,Format('Письмо №%d', [i]));
    writeln(f,'Отправитель: ' + im.SenderName);
    writeln(f,'Кому: ' + im.To);
    writeln(f,'Первая строка письма: ' + copy(im.Body,1,pos(#13,im.body));
    closefile(f); 
  end;
  ns.Logoff;
  OutlookApplication1.Disconnect;
  OutlookApplication1.Quit;
end;

Mozilla Thunderbird рулит)

Сообщение отредактировано: Unconnected - 27.08.2009 13:23

[volvo]

Погоди... Тебе что, надо, чтобы было так: пользователь работает с Аутлуком, твоя программа либо висит где-то на заднем плане, либо вообще не запущена. Выбрали одно из писем, запустили/активировали твою программы, и она сохранила нужные данные? Ну, допустим, Имя приславшего тебе письмо, Текст самого письма, и дата отсылки - не проблема, получается очень просто, даже безо всяких компонентов:

   try
     OutlookApp := GetActiveOleObject('Outlook.Application');
   except
     ShowMessage('Нет запущенной копии MS Outlook'); Exit;
   end;

   for iCount := 1 to OutLookApp.ActiveExplorer.Selection.Count do
   begin
     //
     mailItem := OutLookApp.ActiveExplorer.Selection.Item[iCount];
     s := Format('От %s : "%s", Время отсылки:',
       [mailItem.SenderName, mailItem.Body, mailItem.SentOn]);
     ShowMessage(s);
   end;

, но если тебе надо еще и реальный e-mail, с которого выслано сообщение, то тут будет "биг бада бум", этого ты через Automation Object не получишь, надо будет заморачиваться с интерфейсами. Это только сегодня поздно вечером или завтра, раньше у меня не получится...

[Unconnected]

но если тебе надо еще и реальный e-mail,

А в im.SenderName какой E-mail? Или просто имя отправителя?

[volvo]

Там просто имя отправителя.

[striker]

Погоди... Тебе что, надо, чтобы было так: пользователь работает с Аутлуком, твоя программа либо висит где-то на заднем плане, либо вообще не запущена. Выбрали одно из писем, запустили/активировали твою программы, и она сохранила нужные данные?

Да
И нужен реальный e-mail

[Unconnected]

Реальный, в Оутлуке, если не ошибаюсь, аж в свойствах письма указан, даже не сразу найдёшь..

[volvo]

И нужен реальный e-mail

Ну, тогда тестируй... У меня работает вроде:

procedure TForm1.OutlookClick(Sender: TObject);
var
  i: Integer;
  myOutlookApp: TOutlookApplication;

  mailItem, objReply: OutlookXP.MailItem;
  objRecips: OutlookXP.Recipients;

  iCount: Integer;
  s, s_addr, firstLine: string;
  sL: TStringList;
begin
  // пытаемся подключиться к существующей копии Outlook-а
  // Если не получится - сообщим, что Outlook не запущен, и все...
  myOutlookApp := TOutlookApplication.Create(nil);
  myOutlookApp.ConnectKind := ckRunningInstance;

  try
    myOutlookApp.Connect;
  except
    ShowMessage('Нет запущенной копии MS Outlook');
    myOutlookApp.Free; Exit;
  end;

  // Хм... Все-таки, запущен. Проходим по всем выбранным письмам
  // (их может быть больше одного), и собираем необходимые данные.
  // Для того, чтобы получить адрес - пойдем на хитрость: создадим
  // письмо - ответ (Reply), Outlook в список получателей занесет того,
  // от кого письмо пришло, считаем это значение, и... не будем ничего
  // отправлять...

  for iCount := 1 to myOutlookApp.ActiveExplorer.Selection.Count do
  begin
    mailItem := myOutlookApp.ActiveExplorer.Selection.Item(iCount) as _MailItem;

    objReply := mailItem.Reply;
    objRecips := objReply.Recipients;
    s_addr := '';
    for i := 1 to objRecips.Count do
    begin
      s_addr := s_addr + objRecips.Item(i).Address;
    end;

    // Конечно, выделить первую строку из mailItem.Body можно и по-другому,
    // но мы ж не ищем легких путей...
    sL := TStringList.Create;
    try
      sL.DelimitedText := StringReplace(mailItem.Body, ' ', '&prob;', [rfReplaceAll]);
      firstLine := StringReplace(sL.Strings[0], '&prob;', ' ', [rfReplaceAll]);
    finally
      sL.Free;
    end;

    s := Format('From/To %s <%s> : "%s", sent: %s',
      [mailItem.SenderName, s_addr, firstLine, DateToStr(mailItem.SentOn)]);
    ShowMessage(s);
  end;

  // Все, закончили. Чтоб не было утечки памяти, отключаемся и удаляем объект
  // (не волнуйся, та копия MS Outlook, что была запущена, продолжает работать)
  myOutlookApp.Disconnect;
  myOutlookApp.Free;
end;

В файл запишешь уже сам, наверное...

[striker]

Спасибо, всё работает оч. хорошо.
Время я ещё добавил.
Только вот ещё что, когда отправленное письмо выделяешь, то копируется адрес отправителя, а нужен получателя, т.е кому письмо

[volvo]

Угу... Значит, проверяй, в какой папке находишься, и если это "Sent Mail", то вытаскивать имя не через Reply, а так:

    s_addr := '';
    for i := 1 to mailItem.Recipients.Count do
    begin
      s_addr := s_addr + mailItem.Recipients.Item(i).Address;
    end;

А вот как проверить, где ты находишься - в "Sent Items" или в Inbox - это сразу не скажу, надо проверять, опять нужна машина с MSO, это займет время...

[striker]

Если будет возможность - посмотри, пожалуйста.
Время пока есть

[volvo]

Навскидку (проверь, работает ли) - смотреть, что возвращает:

var currFolderName: String;
...
  currFolderName := myOutlookApp.ActiveExplorer.CurrentFolder.Name;
  if currFolderName = 'Inbox' then // Вот тут может быть другое значение, если русскоязычная версия
  begin
    objReply := mailItem.Reply;
    objRecips := objReply.Recipients;
    s_addr := '';
    for i := 1 to objRecips.Count do
    begin
      s_addr := s_addr + objRecips.Item(i).Address;
    end;
  end
  else
  begin
    s_addr := '';
    for i := 1 to mailItem.Recipients.Count do
    begin
      s_addr := s_addr + mailItem.Recipients.Item(i).Address;
    end;
  end;

[striker]

Да, работает только пишет адрес правильный "кому" а перед ним имя отправителя, т.е моё
Сразу я чего-то пока не вижу где косяк закрался

Сообщение отредактировано: striker - 1.09.2009 1:28

[Unconnected]

а перед ним имя отправителя, т.е моё

Возможно, так и должно быть, типа objRecips.Item(i).Address; или mailItem.Recipients.Item(i).Address; уже содержат имя отправителя?

Просто обрезай ненужную часть строки..