Delphi: How can I read mails from an Outlook folder and save them as .txt files

I need to iterate over all mails in a folder in Outlook and extract the text of the emails for further processing. The solution doesn't have to be pretty; just a pragmatic way for accessing the text of the mails would suffice.

I tried the approach with an ADO Connection. This works fine for iterating over the mails. I can read the subject, length, recipient and other data but I don't know how to get the text of the mail itself. It seems that I have to cast the content to some object but I have no idea what object. If you know how to do that would also be enough for me.

Many thanks in advance.

Regards,

Dirk.
dirkil2Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Luis PérezSoftware Architect in .NetCommented:
I don't know how you're accessing the Outlook items via ADO.net, but have you tried the "Body" property to get the text of the e-mail?
Geert GOracle dbaCommented:
this is something i developed to get the mails from outlook 2007
(you need 2007 to eliminate the annyoing popup, to allow reading the mails by a external app)

it looks in my inbox (folder SAP ALERTS) for mail with the text in textFind

The app also creates a insert in the oracle db to send a sms
A other app picks this up and sends the sms (just a way of allowing multiple apps to send a sms :) )
unit uTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleServer, OutlookXP, Buttons, ExtCtrls;

const
  FolderFind = 'SAP ALERTS';
  textFind = 'ALERT for SOL \ Availability \,RED CCMS alert';
  MaxAttempts = 60;
  OraServer = '#######';
  OraUser   = '#######';
  OraPass   = '#######';
  OraSmsProc = '####################################';
  MaxSmsLen = 160;
  SmsRecipients = '###############'; 
  MaxLines = 500;
  MaxLinesDelta = 25;

type
  TfrmSapAlerter = class(TForm)
    memInfo: TMemo;
    outlook: TOutlookApplication;
    pnlOptions: TPanel;
    btnStart: TBitBtn;
    btnStop: TBitBtn;
    timerCheck: TTimer;
    timerStart: TTimer;
    btnRunNow: TBitBtn;
    btnConfig: TBitBtn;
    chkTest: TCheckBox;
    procedure btnStartClick(Sender: TObject);
    procedure timerCheckTimer(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure timerStartTimer(Sender: TObject);
    procedure btnRunNowClick(Sender: TObject);
  private
    fRunning: Boolean;
    procedure AddMsg(Msg: String);
    function FindFolder(aName: string; aFolder: MapiFolder): MapiFolder;
    function ValidMsg(m: MailItem): Boolean;
    procedure SendSms(Msg: string);
    procedure CheckMails;
    procedure SetRunning(const Value: boolean);
    function DoSendSms(nr, msg, body: string): boolean;
    procedure WMUser(var Msg: TMessage); message WM_USER;
  protected
    procedure UpdateActions; override;
    property Running: boolean read fRunning write SetRunning;

  public

  end;

var
  frmSapAlerter: TfrmSapAlerter;

implementation

uses MemDS, DBAccess, Ora, StrUtils;

{$R *.dfm}

procedure TfrmSapAlerter.AddMsg(Msg: String);
var I: Integer;
begin
  if memInfo.Lines.Count >= MaxLines then
    for I := 0 to MaxLinesDelta- 1 do
      memInfo.Lines.Delete(0);
  memInfo.Lines.Add(Msg);
end;

procedure TfrmSapAlerter.FormShow(Sender: TObject);
begin
  PostMessage(Handle, WM_USER, 0, 0);
end;

procedure TfrmSapAlerter.WMUser(var Msg: TMessage);
begin
  timerStart.Enabled := True;
end;

function TfrmSapAlerter.DoSendSms(nr, msg, body: string): boolean;
var  s: TOraSession;
  q: TOraStoredProc;
begin
  Result := False;
  s := TOraSession.Create(nil);
  try
    s.Server := OraServer;
    s.Username := OraUser;
    s.Password := OraPass;
    s.LoginPrompt := False;
    try
      AddMsg('Trying database connection ...');
      s.Connect;
      if s.Connected then
      try
        AddMsg('Database connected ...');
        q := TOraStoredProc.Create(nil);
        try
          q.StoredProcName := OraSmsProc;
          try
            q.Prepare;
            q.ParamByName('I_GSMNR').AsString := nr;
            q.ParamByName('I_SUBJECT').AsString := msg;
            q.ParamByName('I_MESSAGE').AsString := body;
            q.ExecProc;
            AddMsg('Sms sent to database !');
            Result := True;
          except
            on E: SysUtils.Exception do
            begin
              AddMsg('Exception occured: ' + E.Message);
            end;
          end;
        finally
          q.Free;
        end;
      finally
        s.Disconnect;
        AddMsg('Database disconnected.');
      end;
    except
      on E: SysUtils.Exception do
      begin
        AddMsg('Connection failed to oracle server');
      end;
    end;
  finally
    s.Free;
  end;
end;

procedure TfrmSapAlerter.SendSms(Msg: string);
var List: TStringList;
  I: Integer;
begin
  if not chkTest.Checked then
  begin
    AddMsg(Msg);
    List := TStringList.Create;
    try
      List.StrictDelimiter := True;
      List.CommaText := SmsRecipients;
      for I := 0 to List.Count - 1 do
        DoSendSms(List[I], 'SAP ALERT', Copy(Msg, 1, MaxSmsLen));
    finally
      List.Free;
    end;
  end else
    AddMsg('SendSms Test: ' + Msg);
end;

procedure TfrmSapAlerter.SetRunning(const Value: boolean);
begin
  fRunning := Value;
  timerCheck.Enabled := False;
  timerCheck.Enabled := Value;
  AddMsg('Mail check ' + IfThen(Value, '', 'not ') + 'running ' + DateTimeToStr(Now));
end;

procedure TfrmSapAlerter.timerCheckTimer(Sender: TObject);
begin
  timerCheck.Enabled := False;
  AddMsg('Starting check '+  DateTimeToStr(Now));
  CheckMails;
  timerCheck.Enabled := fRunning;
end;

procedure TfrmSapAlerter.timerStartTimer(Sender: TObject);
begin
  Running := True;
  timerStart.Enabled := False;
end;

procedure TfrmSapAlerter.UpdateActions;
begin
  btnStart.Enabled := not fRunning;
  btnStop.Enabled := timerStart.Enabled or fRunning;
end;

procedure TfrmSapAlerter.btnStopClick(Sender: TObject);
begin
  timerStart.Enabled := False;
  Running := False;
end;

procedure TfrmSapAlerter.btnRunNowClick(Sender: TObject);
begin
  CheckMails;
end;

procedure TfrmSapAlerter.btnStartClick(Sender: TObject);
begin
  Running := True;
end;

function TfrmSapAlerter.FindFolder(aName: string; aFolder: MapiFolder): MapiFolder;
var
  I: OleVariant;
  n: Integer;
  x: MapiFolder;
begin
  Result := nil;
  if aFolder.Name = aName then
    Result := aFolder
  else
  begin
    n := aFolder.Folders.Count;
    if n > 0 then
    begin
      I := 1;
      while I <= n do
      begin
        x := FindFolder(aName, aFolder.Folders.Item(I));
        if Assigned(x) then
        begin
          Result := X;
          Break;
        end;
        I := I +1;
      end;
    end;
  end;
end;

function TfrmSapAlerter.ValidMsg(m: MailItem): Boolean;
var
  List: TStringList;
  I, n: integer;
  Msg: string;
begin
  Result := False;
  Msg := UpperCase(m.Body);
  List := TStringList.Create;
  try
    List.StrictDelimiter := True;
    List.CommaText := textFind;
    n := 0;
    for I := 0 to List.Count - 1 do
      if Pos(UpperCase(List[I]), Msg) > 0 then
        Inc(n);
    if n >= List.Count then
      Result := True;
  finally
    List.Free;
  end;
end;

procedure TfrmSapAlerter.CheckMails;
var f: MapiFolder;
  n: Integer;
  I: OleVariant;
  m: MailItem;
  x: IDispatch;
begin
  outlook.Connect;
  try
    I := 1;
    f := FindFolder(FolderFind, outlook.GetNamespace('MAPI').GetDefaultFolder(olFolderInbox));
    if Assigned(f) then
    begin
      I := 1;
      n := f.Items.Count;
      while I < n do
      begin
        x := f.Items.Item(I);
        if x.QueryInterface(_MailItem, m) = S_OK then
        begin
          if m.UnRead <> False then
          begin
            if ValidMsg(m) then
            begin
              SendSms(m.Subject + ' ' + m.Body);
              m.UnRead := False;
            end;
          end;
        end;
        I := I + 1;
      end;
    end;
  finally
    outlook.Disconnect;
  end;
end;

end.

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Geert GOracle dbaCommented:
dfm
object frmSapAlerter: TfrmSapAlerter
  Left = 365
  Top = 206
  Caption = 'Sap Alert SMS sender [DO NOT CLOSE APPLICATION !]'
  ClientHeight = 451
  ClientWidth = 590
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object memInfo: TMemo
    Left = 0
    Top = 65
    Width = 590
    Height = 386
    Align = alClient
    ScrollBars = ssBoth
    TabOrder = 0
  end
  object pnlOptions: TPanel
    Left = 0
    Top = 0
    Width = 590
    Height = 65
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 1
    object btnStart: TBitBtn
      Left = 7
      Top = 5
      Width = 75
      Height = 57
      Caption = 'Start'
      DoubleBuffered = True
      ParentDoubleBuffered = False
      TabOrder = 0
      OnClick = btnStartClick
    end
    object btnStop: TBitBtn
      Left = 103
      Top = 5
      Width = 75
      Height = 57
      Caption = 'Stop'
      DoubleBuffered = True
      ParentDoubleBuffered = False
      TabOrder = 1
      OnClick = btnStopClick
    end
    object btnRunNow: TBitBtn
      Left = 207
      Top = 5
      Width = 75
      Height = 57
      Caption = 'Run now'
      DoubleBuffered = True
      ParentDoubleBuffered = False
      TabOrder = 2
      OnClick = btnRunNowClick
    end
    object btnConfig: TBitBtn
      Left = 311
      Top = 5
      Width = 75
      Height = 57
      Caption = 'Config'
      DoubleBuffered = True
      ParentDoubleBuffered = False
      TabOrder = 3
    end
    object chkTest: TCheckBox
      Left = 408
      Top = 16
      Width = 97
      Height = 17
      Caption = 'Testing'
      Checked = True
      State = cbChecked
      TabOrder = 4
    end
  end
  object outlook: TOutlookApplication
    AutoConnect = False
    ConnectKind = ckRunningOrNew
    AutoQuit = False
    Left = 400
    Top = 32
  end
  object timerCheck: TTimer
    Interval = 600000
    OnTimer = timerCheckTimer
    Left = 336
    Top = 32
  end
  object timerStart: TTimer
    Enabled = False
    Interval = 5000
    OnTimer = timerStartTimer
    Left = 280
    Top = 104
  end
end

Open in new window

dirkil2Author Commented:
Thanks for the asnwer. I haven't had time to check it. I will do that soon.
dirkil2Author Commented:
Thank you for your good answer.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
C#

From novice to tech pro — start learning today.