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

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


Category

  김영대(2003-03-07 10:03:51, Hit : 4661, Vote : 1170
 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   [COM/OLE] Win2k, Win Xp - Active X - Dax error : Access violation해결(IE상에서)  신훈재 2003/03/20 6729 1173
290   [데이터베이스] Query.RecordCount = -1  김영대 2003/03/07 4983 1173
289   [네트웍/인터넷] Read/Write to COM Port  김영대 2003/03/07 4943 1173
288   [일반/컴포넌트] 문자열의 끝에서부터 검색하는 Pos() 함수  김영대 2003/03/07 5063 1173
287   [일반/컴포넌트] Memo의 입력행수 제한하기  김영대 2003/03/07 4111 1172
286   [윈도우즈 API] bitmap 인쇄하기  김영대 2003/03/05 4513 1172
285   [일반/컴포넌트] TStringGrid 인쇄하기  김영대 2003/03/07 4765 1170
284   [일반/컴포넌트] StringGrid 의 BeginUpdate/EndUpdate ?  김영대 2003/03/07 5420 1170
  [일반/컴포넌트] MS-OutLook 으로 메시지 보내기  김영대 2003/03/07 4661 1170
282   [데이터베이스] 몇가지 BDE 환경정보 구하기  김영대 2003/03/07 4347 1169
281   [COM/OLE] How to register an OCX  김영대 2003/03/06 4959 1169
280   [일반/컴포넌트] 하나의 프로시저,함수로 다른 함수,프로시저를 처리  김영대 2003/03/05 3992 1169
279   [일반/컴포넌트] TRichEdit 에 윗첨자, 아랫첨자 만들기  김영대 2003/03/07 4514 1168
278   [윈도우즈 API] 바로 직전에 active 되었던 윈도우와 콘트롤 구하기  김영대 2004/07/24 4608 1167
277     [COM/OLE] [re] PDF ActiveX 사용하기  초보델피 2005/07/18 5232 1166
276   [일반/컴포넌트] ComboBox에 IE의 URL 입력창 같은 근접검색 두기  김영대 2003/03/31 4600 1163
275   [윈도우즈 API] 데스크탑 아이콘 전부 감추기/보이기  김영대 2003/03/07 3929 1162
274   [일반/컴포넌트] 표준 콘트롤의 몇가지 한계  김영대 2003/03/05 4296 1161
273   [일반/컴포넌트] 수직 스크롤이 맨마지막으로 이동했는지 검사  김영대 2003/03/07 3925 1160
272   [윈도우즈 API] Hotkey를 이용하여 다른 프로그램에 글자 쓰기  김영대 2003/03/07 4212 1160
271   [시스템] PC에 설치된 드라이브 목록 구하기  김영대 2003/03/07 4695 1159
270   [일반/컴포넌트] 프로그램 종료시 도움말 화면 닫기  김영대 2003/03/05 4205 1159
269   [알고리즘] 숫자를 KB, MB, GB 단위로 환산하기  김영대 2003/11/13 4995 1158
268   [시스템] 프린터에 escape 코드를 전달하는 방법  김영대 2003/03/06 3904 1158
267   [데이터베이스] Paradox 테이블이 깨졌을때...  김영대 2003/03/05 5006 1158
266   [윈도우즈 API] "문서" 메뉴에 파일을 등록하고 삭제하기  김영대 2003/03/05 4290 1158
265   [일반/컴포넌트] Memo의 커서를 특정 위치로 보낸후 scroll 시키기  김영대 2003/03/05 4933 1158
264   [시스템] 일정시간 경과 후 윈도우즈 종료하기  김영대 2004/08/03 4669 1157
263   [일반/컴포넌트] Variant 변수의 Type 알아내기  김영대 2003/03/05 4334 1157
262   [일반/컴포넌트] 파일에서 특정 Byte 모두 찾기  김영대 2003/03/07 4489 1155
261   [시스템] 쓰레드 내에서 폼을 생성해보자  구창민 2003/03/14 5484 1154
260   [일반/컴포넌트] Button의 Mouse Down/Up 흉내내기  김영대 2003/03/07 4434 1154
259   [데이터베이스] SQL실행시의 모래시계를 표시하지 않는 방법  김영대 2003/03/07 4632 1154
258   [윈도우즈 API] IE의 현재 url 가져오기  김영대 2003/03/07 4571 1153
257   [시스템] Thread 사용하기  김영대 2003/03/07 4193 1152
256   [시스템] 화면보호기가 설치되어 있는지 검사하기  김영대 2003/03/07 3953 1152
255   [일반/컴포넌트] Button에 여러줄의 Caption 넣기  김영대 2003/03/05 4402 1151
254   [일반/컴포넌트] 윈도우즈"시작" 버튼위에 글씨 쓰기  김영대 2004/07/24 4177 1150
253   [일반/컴포넌트] TTreeView 에 관한 도움말  김영대 2003/03/05 4619 1150
252   [일반/컴포넌트] INI file 에서 section 단위로 읽기  김영대 2004/08/17 4636 1149

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

Copyright 1999-2021 Zeroboard / skin by zero