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

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


Category

  김영대(2003-03-07 10:03:51, Hit : 5100, Vote : 1175
 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   [윈도우즈 API] bitmap 인쇄하기 2  김영대 2003/03/05 4352 1178
290   [시스템] 쓰레드 내에서 폼을 생성해보자  구창민 2003/03/14 5599 1177
289   [일반/컴포넌트] 모든 드라이브,디렉토리 검색하여 파일 찾기  김영대 2003/03/07 4685 1177
288   [윈도우즈 API] Application 에 발생하는 메시지 구경하기  김영대 2003/03/05 4651 1176
287   [데이터베이스] Query.RecordCount = -1  김영대 2003/03/07 5034 1175
  [일반/컴포넌트] MS-OutLook 으로 메시지 보내기  김영대 2003/03/07 5100 1175
285   [일반/컴포넌트] 문자열의 끝에서부터 검색하는 Pos() 함수  김영대 2003/03/07 5098 1175
284   [일반/컴포넌트] ListBox의 화면에 보여지는 최상위 Item 번호  김영대 2003/03/07 4316 1174
283   [일반/컴포넌트] 쓰레드를 이용한 복수 Query 동시에 열기  김영대 2003/03/05 6316 1174
282   [일반/컴포넌트] Memo의 입력행수 제한하기  김영대 2003/03/07 4129 1172
281   [윈도우즈 API] bitmap 인쇄하기  김영대 2003/03/05 4526 1172
280   [일반/컴포넌트] StringGrid 의 BeginUpdate/EndUpdate ?  김영대 2003/03/07 5469 1171
279   [COM/OLE] How to register an OCX  김영대 2003/03/06 4996 1171
278   [일반/컴포넌트] TStringGrid 인쇄하기  김영대 2003/03/07 4783 1170
277   [데이터베이스] Paradox 테이블이 깨졌을때...  김영대 2003/03/05 5050 1170
276   [데이터베이스] 몇가지 BDE 환경정보 구하기  김영대 2003/03/07 4366 1169
275   [일반/컴포넌트] TRichEdit 에 윗첨자, 아랫첨자 만들기  김영대 2003/03/07 4535 1169
274   [일반/컴포넌트] 하나의 프로시저,함수로 다른 함수,프로시저를 처리  김영대 2003/03/05 4009 1169
273   [윈도우즈 API] 바로 직전에 active 되었던 윈도우와 콘트롤 구하기  김영대 2004/07/24 4629 1168
272     [COM/OLE] [re] PDF ActiveX 사용하기  초보델피 2005/07/18 5277 1167
271   [일반/컴포넌트] ComboBox에 IE의 URL 입력창 같은 근접검색 두기  김영대 2003/03/31 4627 1163
270   [일반/컴포넌트] 수직 스크롤이 맨마지막으로 이동했는지 검사  김영대 2003/03/07 3943 1162
269   [윈도우즈 API] 데스크탑 아이콘 전부 감추기/보이기  김영대 2003/03/07 3940 1162
268   [일반/컴포넌트] 표준 콘트롤의 몇가지 한계  김영대 2003/03/05 4315 1162
267   [시스템] PC에 설치된 드라이브 목록 구하기  김영대 2003/03/07 4733 1160
266   [윈도우즈 API] "문서" 메뉴에 파일을 등록하고 삭제하기  김영대 2003/03/05 4310 1159
265   [일반/컴포넌트] Variant 변수의 Type 알아내기  김영대 2003/03/05 4357 1159
264   [일반/컴포넌트] Memo의 커서를 특정 위치로 보낸후 scroll 시키기  김영대 2003/03/05 4987 1159
263   [일반/컴포넌트] 프로그램 종료시 도움말 화면 닫기  김영대 2003/03/05 4219 1159
262   [시스템] 일정시간 경과 후 윈도우즈 종료하기  김영대 2004/08/03 4684 1158
261   [알고리즘] 숫자를 KB, MB, GB 단위로 환산하기  김영대 2003/11/13 5047 1158
260   [시스템] 프린터에 escape 코드를 전달하는 방법  김영대 2003/03/06 3921 1158
259   [일반/컴포넌트] 파일에서 특정 Byte 모두 찾기  김영대 2003/03/07 4519 1156
258   [일반/컴포넌트] Button의 Mouse Down/Up 흉내내기  김영대 2003/03/07 4468 1155
257   [일반/컴포넌트] 베쥬(Bezier) 곡선 그리기2  김영대 2003/03/07 4851 1155
256   [일반/컴포넌트] 부활절 달걀(easter egg) 문자열 입력받기  김영대 2003/03/07 4792 1154
255   [데이터베이스] SQL실행시의 모래시계를 표시하지 않는 방법  김영대 2003/03/07 4665 1154
254   [윈도우즈 API] IE의 현재 url 가져오기  김영대 2003/03/07 4602 1154
253   [시스템] Thread 사용하기  김영대 2003/03/07 4209 1153
252   [시스템] 화면보호기가 설치되어 있는지 검사하기  김영대 2003/03/07 3973 1153

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

Copyright 1999-2022 Zeroboard / skin by zero