Solved

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

Posted on 2010-09-16
5
809 Views
Last Modified: 2012-05-10
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.
0
Comment
Question by:dirkil2
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 25

Expert Comment

by:Luis Pérez
ID: 33691255
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?
0
 
LVL 38

Accepted Solution

by:
Geert Gruwez earned 500 total points
ID: 33691363
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

0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 33691369
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

0
 

Author Comment

by:dirkil2
ID: 33715508
Thanks for the asnwer. I haven't had time to check it. I will do that soon.
0
 

Author Closing Comment

by:dirkil2
ID: 33757250
Thank you for your good answer.
0

Featured Post

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to resolve IMCEAEX NDRs in Exchange or Exchange Online related to invalid X500 addresses.
This article will help to fix the below errors for MS Exchange Server 2013 I. Certificate error "name on the security certificate is invalid or does not match the name of the site" II. Out of Office not working III. Make Internal URLs and Externa…
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.

636 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question