::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2003-03-07 10:03:51, Hit : 5172, Vote : 1181
 MS-OutLook 으로 메시지 보내기

If you are using MSOutlook then this should do the trick, otherwise I don't
have a clue.

Unit1 code:
unit Unit1;

{*************************************************************************}
{ Programmer:   Kevin S. Gallagher                                        }
{ Description:  Shows simple example of sending a message via MS-OutLook  }
{ Comments:                                                               }
{               1.  You need to place a valid email address into the      }
{                   textbox "txtMailTo".                                  }
{               2.  Review my comments on sending attachments. I only do  }
{                   a single attachement, although multiples are simple.  }
{               3.  Although the attachments work, I didn't attempt to    }
{                   figure out why they show in the message area instead  }
{                   of in the "attachment area".                          }
{*************************************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ExtCtrls, ComCtrls;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    mnuFile: TMenuItem;
    mnuAbout: TMenuItem;
    Sep1: TMenuItem;
    mnuExitdemo: TMenuItem;
    cmsSendMail: TButton;
    ListBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    txtMailTo: TEdit;
    txtSubject: TEdit;
    cmdAttachFile: TButton;
    lblAttachDoc: TLabel;
    MessageGroupBox: TGroupBox;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    cmdExit: TButton;
    StatusBar1: TStatusBar;
    rdoImportance: TRadioGroup;
    procedure cmsSendMailClick(Sender: TObject);
    procedure mnuExitdemoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmdAttachFileClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    {$IFNDEF VER120}
    procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO ;
    {$ENDIF}
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  cAttachFile:String ;

implementation

uses ShellAPI, ComObj ;

{$R *.DFM}

procedure TfrmMain.cmsSendMailClick(Sender: TObject);
  function NoCrLf(const cMsg:String):String ;
  var nLen,i:Integer ;
  begin
    nLen := Length(cMsg) ;
    i := 1;
    while i <= nLen do begin
      if cMsg[i] in [#10,#13] then
        Result := Result + ''
      else
        Result := Result + cMsg[i] ;
      Inc(i) ;
    end ;
  end ;
const
  aOutLook = 'Outlook.Application' ;
  olMailitem = 0 ;
  olImportanceLow = 0 ;
  olImportanceNormal = 1 ;
  olImportanceHigh = 2 ;
var
  OutLook,
  MailItem: Variant ;
  cTo,
  cSubject,
  cMessage:String ;
  i:Integer ;
begin

  ListBox1.Items.Clear ;

  cTo := txtMailTo.Text ;
  cSubject := txtSubject.Text ;

  if Length(cTo) = 0 then begin
    MessageDlg('Must supply a name to send message to!',mtError,[mbOK],0) ;
    exit ;
  end ;

  if Length(cSubject) = 0 then
    cSubject := 'This is a test of sending mail in Delphi' ;

  for i := 0 to Memo1.Lines.Count do begin
    cMessage := Memo1.Lines.Strings[i] ;
  end ;

  if Length(cMessage) >0 then
    cMessage := NoCrLf(cMessage)
  else
    cMessage := 'This is a test' ;

  try
    try
     OutLook := GetActiveOleObject(aOutLook) ;
      ListBox1.Items.Add('Utilizing OutLook Object') ;
    except
      OutLook := CreateOleObject(aOutLook) ;
      ListBox1.Items.Add('Created OutLook Object') ;
    end;
  except
    ListBox1.Items.Add('failed to create ' + aOutLook) ;
    MessageDlg('Unable to create OLE Object for' + #13 +
aOutLook,mtError,[mbOK],0) ;
    exit ;
  end;

  try
    mailitem:= Outlook.CreateItem(olMailitem) ;
    case rdoImportance.ItemIndex of
      0: MailItem.Importance := olImportanceLow ;
      1: MailItem.Importance := olImportanceNormal ;
      2: MailItem.Importance := olImportanceHigh ;
    end;

    ListBox1.Items.Add('Created Mail Item') ;
  except
    ListBox1.Items.Add('Failed to create Mail Item') ;
    messageDlg('Unable to create mail item',mtError,[mbOK],0) ;
    exit ;
  end;

  try
    try
      MailItem.To := cTo ;
      MailItem.Recipients.ResolveAll ;
      Mailitem.Subject := cSubject ;
      { To keep things simple, we only allow sending one attachment.
        If you need to send more then one attachment, then build
        code to use a TStringList, cycle through it and add the
        attachment. i.e.

        for i := 0 to LengthOfStringList do
          Mailitem.Attachments.Add(aAttachments[i]) ;        }

      if length(cAttachFile) >0 then
        MailItem.Attachments.Add(cAttachFile) ;
      MailItem.Body := 'This is a test of automating OutLook'+ #13 +#10 ;
      ListBox1.Items.Add('SendingMessage...') ;
      MailItem.Send ;
      ListBox1.Items.Add('Message sent!') ;
      except on Exception do begin
        ListBox1.Items.Add('Message not sent') ;
        MessageDlg('Error Sending Report',mtError,[mbOK],0) ;
        exit ;
      end ;
    end ;
  finally
    {------------------------------------------------------------------
      Here I dereference <OutLook> variable rather then telling OutLook
      to quit. You could modify the code to see if GetOleObject or
      CreateOleObject was used, thus determing if the object should be
      unassigned or have OutLook close down
    ------------------------------------------------------------------}
    OutLook := Unassigned ;
    if VarIsEmpty(OutLook) then
      ListBox1.Items.Add('released OutLook Object')
    else
      ListBox1.Items.Add('OutLook Object not released properly') ;
    // Outlook.Quit;   -- See above comment.
  end;
end;
procedure TfrmMain.mnuExitdemoClick(Sender: TObject);
begin
  Close ;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  cAttachFile := '' ;
  rdoImportance.ItemIndex := 0 ;
end;

procedure TfrmMain.cmdAttachFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
    cAttachFile := OpenDialog1.FileName ;
    lblAttachDoc.Caption := cAttachFile ;
  end else
  lblAttachDoc.Caption := 'None' ;
end;

procedure TfrmMain.FormResize(Sender: TObject);
var
  x:Integer ;
begin
  cmdExit.Left := (Width - cmdExit.Width) - 10 ;
  cmdExit.Top := (ClientHeight  - cmdExit.Height) - 20 ;

  MessageGroupBox.Width := (Panel1.Width - ListBox1.Width) - 15 ;
end;

{$IFNDEF VER120}
procedure TfrmMain.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo) ;
begin
  { Just having a little fun }
  with Message.MinMaxInfo^ do begin
    // Restrain min dimension of form (width/height)
    ptMinTrackSize := Point(522,387) ;
    ptMaxTrackSize := Point(800,387) ;
  end;
  Message.Result := 0;
  inherited ;
end ;
{$ENDIF}

end.


DFM Code
(Save as Unit1.txt, then run Convert.exe found in Delphi's Bin directory to
create
a DFM file)
object frmMain: TfrmMain
  Left = 200
  Top = 108
  Width = 522
  Height = 387
  Caption = 'Automating MS-OutLook'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  ShowHint = True
  OnCreate = FormCreate
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 514
    Height = 281
    Align = alTop
    TabOrder = 0
    object Label1: TLabel
      Left = 26
      Top = 16
      Width = 31
      Height = 13
      Caption = 'Mail to'
    end
    object Label2: TLabel
      Left = 21
      Top = 48
      Width = 36
      Height = 13
      Caption = 'Subject'
    end
    object lblAttachDoc: TLabel
      Left = 64
      Top = 212
      Width = 26
      Height = 13
      Caption = 'None'
    end
    object cmsSendMail: TButton
      Left = 3
      Top = 245
      Width = 75
      Height = 25
      Hint = 'Send the message'
      Caption = '&Send'
      TabOrder = 4
      OnClick = cmsSendMailClick
    end
    object ListBox1: TListBox
      Left = 286
      Top = 1
      Width = 227
      Height = 279
      Hint = 'Shows processing of code events'
      TabStop = False
      Align = alRight
      ItemHeight = 13
      TabOrder = 6
    end
    object txtMailTo: TEdit
      Left = 62
      Top = 15
      Width = 171
      Height = 21
      Hint = 'Enter a email address to send the message too'
      TabOrder = 0
      Text = 'SomeName@SomeLocation.com'
    end
    object txtSubject: TEdit
      Left = 62
      Top = 47
      Width = 223
      Height = 21
      Hint = 'Enter the Subjec of this message'
      TabOrder = 1
    end
    object cmdAttachFile: TButton
      Left = 8
      Top = 210
      Width = 49
      Height = 20
      Hint = 'Attach a document to your message'
      Caption = 'Add File'
      TabOrder = 5
      OnClick = cmdAttachFileClick
    end
    object MessageGroupBox: TGroupBox
      Left = 8
      Top = 127
      Width = 273
      Height = 73
      Caption = 'Message'
      TabOrder = 3
      object Memo1: TMemo
        Left = 2
        Top = 15
        Width = 269
        Height = 56
        Align = alClient
        Lines.Strings = (
          'Place your message here!')
        TabOrder = 0
      end
    end
    object rdoImportance: TRadioGroup
      Left = 61
      Top = 72
      Width = 185
      Height = 57
      Caption = 'Importance'
      Items.Strings = (
        'Low'
        'Normal'
        'High')
      TabOrder = 2
    end
  end
  object cmdExit: TButton
    Left = 437
    Top = 295
    Width = 75
    Height = 25
    Caption = 'E&xit'
    TabOrder = 1
    OnClick = mnuExitdemoClick
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 322
    Width = 514
    Height = 19
    Panels = <>
    SimplePanel = False
  end
  object MainMenu1: TMainMenu
    Left = 614
    Top = 178
    object mnuFile: TMenuItem
      Caption = '&File'
      object mnuAbout: TMenuItem
        Caption = '&About'
      end
      object Sep1: TMenuItem
        Caption = '-'
      end
      object mnuExitdemo: TMenuItem
        Caption = 'E&xit'
        OnClick = mnuExitdemoClick
      end
    end
  end
  object OpenDialog1: TOpenDialog
    Filter =
      'MS-Word document|*.doc|MS-Excel spreadsheet|*.xls|MS-DOS text fi' +
      'le|*.txt|BitMap file|*.bmp|All file(s)|*.*'
    Left = 612
    Top = 118
  end
end





291   [일반/컴포넌트] StringGrid의 모든 Cell 선택/해제하기  김영대 2004/09/25 4905 1183
290   [시스템] 특정 DLL 의 함수목록을 구해보자.  구창민 2003/03/14 5602 1183
289   [데이터베이스] Paradox 테이블이 깨졌을때...  김영대 2003/03/05 5089 1183
288   [일반/컴포넌트] 문자열의 word 갯수 세기  김영대 2003/03/04 4372 1183
287   [일반/컴포넌트] 타이틀바 클릭시 사용자 팝업메뉴 보이기  김영대 2003/03/07 4927 1182
286   [윈도우즈 API] 어플리케이션의 중복실행 방지  김영대 2003/03/05 4784 1182
285   [일반/컴포넌트] TRichEdit 에 윗첨자, 아랫첨자 만들기  김영대 2003/03/07 4579 1181
284   [윈도우즈 API] How to flush key buffer  김영대 2003/03/07 4469 1181
  [일반/컴포넌트] MS-OutLook 으로 메시지 보내기  김영대 2003/03/07 5172 1181
282   [시스템] Hint의 폰트 바꾸기  김영대 2003/03/05 4090 1181
281   [일반/컴포넌트] ListBox의 화면에 보여지는 최상위 Item 번호  김영대 2003/03/07 4356 1180
280   [일반/컴포넌트] 문자열의 끝에서부터 검색하는 Pos() 함수  김영대 2003/03/07 5141 1180
279   [일반/컴포넌트] Memo의 입력행수 제한하기  김영대 2003/03/07 4175 1179
278   [윈도우즈 API] bitmap 인쇄하기  김영대 2003/03/05 4560 1179
277   [일반/컴포넌트] TStringGrid 인쇄하기  김영대 2003/03/07 4806 1178
276   [일반/컴포넌트] 쓰레드를 이용한 복수 Query 동시에 열기  김영대 2003/03/05 6480 1178
275   [윈도우즈 API] 바로 직전에 active 되었던 윈도우와 콘트롤 구하기  김영대 2004/07/24 4667 1175
274   [데이터베이스] 몇가지 BDE 환경정보 구하기  김영대 2003/03/07 4449 1175
273   [COM/OLE] How to register an OCX  김영대 2003/03/06 5057 1173
272   [알고리즘] 숫자를 KB, MB, GB 단위로 환산하기  김영대 2003/11/13 5102 1172
271   [시스템] PC에 설치된 드라이브 목록 구하기  김영대 2003/03/07 4781 1172
270     [COM/OLE] [re] PDF ActiveX 사용하기  초보델피 2005/07/18 5328 1171
269   [일반/컴포넌트] ComboBox에 IE의 URL 입력창 같은 근접검색 두기  김영대 2003/03/31 4668 1170
268   [일반/컴포넌트] 베쥬(Bezier) 곡선 그리기2  김영대 2003/03/07 6087 1168
267   [일반/컴포넌트] 수직 스크롤이 맨마지막으로 이동했는지 검사  김영대 2003/03/07 3971 1167
266   [시스템] 일정시간 경과 후 윈도우즈 종료하기  김영대 2004/08/03 4720 1166
265   [일반/컴포넌트] 부활절 달걀(easter egg) 문자열 입력받기  김영대 2003/03/07 4835 1166
264   [시스템] 프린터에 escape 코드를 전달하는 방법  김영대 2003/03/06 3958 1166
263   [윈도우즈 API] 데스크탑 아이콘 전부 감추기/보이기  김영대 2003/03/07 3953 1164
262   [일반/컴포넌트] Memo의 커서를 특정 위치로 보낸후 scroll 시키기  김영대 2003/03/05 5053 1164
261   [일반/컴포넌트] 프로그램 종료시 도움말 화면 닫기  김영대 2003/03/05 4256 1163
260   [윈도우즈 API] "문서" 메뉴에 파일을 등록하고 삭제하기  김영대 2003/03/05 4353 1162
259   [일반/컴포넌트] Variant 변수의 Type 알아내기  김영대 2003/03/05 4406 1162
258   [일반/컴포넌트] 표준 콘트롤의 몇가지 한계  김영대 2003/03/05 4351 1162
257   [시스템] Thread 사용하기  김영대 2003/03/07 4254 1160
256   [일반/컴포넌트] 파일에서 특정 Byte 모두 찾기  김영대 2003/03/07 4549 1159
255   [일반/컴포넌트] Adobe Acrobat 이 설치되었는지 검사하기  김영대 2004/08/06 4618 1158
254   [일반/컴포넌트] 표준 TListBox 에 Radio 버튼 올리기  김영대 2004/07/27 4235 1158
253   [일반/컴포넌트] Button의 Mouse Down/Up 흉내내기  김영대 2003/03/07 4508 1157
252   [데이터베이스] SQL실행시의 모래시계를 표시하지 않는 방법  김영대 2003/03/07 4705 1157

[이전 10개] [1]..[11][12][13][14][15][16][17] 18 [19][20]..[25] [다음 10개]
 

Copyright 1999-2022 Zeroboard / skin by zero