Send an email with an attachment

Problem/Question/Abstract:

How to send an email with an attachment

Answer:

Solve 1:

For Outlook mail:

uses
  ComObj;

procedure MailItem;
const
  olMailItem = 0;
var
  Outlook: OLEVariant;
  MailItem: Variant;
begin
  try
    Outlook := GetActiveOleObject('Outlook.Application');
  except
    Outlook := CreateOleObject('Outlook.Application');
  end;
  MailItem := Outlook.CreateItem(olMailItem);
  MailItem.Recipients.Add(< email address here > );
  MailItem.Subject := 'your subject';
  MailItem.Body := 'This is sample text';
  MailItem.Attachments.Add('C:\Windows\Win.ini');
  MailItem.Send;
  Outlook := Unassigned;
end;


Solve 2:

There have been many questions about how to send an e-mail with an attachment. I came up with the vbs script that did it with Outlook.

Well here's the Delphi translation that uses OLE to accomplish the same thing:

Change recipientaddress@recipienthost.com to your own e-mail address and give it a try. You must have Outlook installed, I'm not sure if this will work with Outlook Express.

procedure TForm1.Button1Click(Sender: TObject);
const
  { OlItemType constants }
  olMailItem = 0;
  olAppointmentItem = 1;
  olContactItem = 2;
  olTaskItem = 3;
  olJournalItem = 4;
  olNoteItem = 5;
  olPostItem = 6;
  { OlAttachmentType constants }
  olByValue = 1;
  olByReference = 4;
  olEmbeddedItem = 5;
  olOLE = 6;
var
  myOlApp, myItem, myRecipient, myAttachments: OleVariant;
begin
  { VBScript file to create a mail and add an attachment }
  myOlApp := CreateOLEObject('Outlook.Application');
  myItem := myOlApp.CreateItem(olMailItem);
  myItem.Subject := 'This is the Subject';
  myRecipient := myItem.Recipients.Add('recipientaddress@recipienthost.com');
  myItem.Body := #13;
  myItem.Body := myItem.Body + #13;
  myItem.Body := myItem.Body + 'Hello,' + #13;
  myItem.Body := myItem.Body + 'This code created this message and ' +
    ' sent it and I didn'' t even have' + #13;
  myItem.Body := myItem.Body + 'to click the send button!!!' + #13;
  myItem.Body := myItem.Body + #13;
  myItem.Body := myItem.Body + 'If you have any more problems, let me know' + #13;
  myItem.Body := myItem.Body + 'rename to blah.vbs and run like this:' + #13;
  myItem.Body := myItem.Body + 'wscript c:\blah.vbs' + #13;
  myItem.Body := myItem.Body + #13;
  myItem.Body := myItem.Body + 'MrBaseball34' + #13;
  myItem.Body := myItem.Body + #13;
  myItem.Body := myItem.Body + #13;
  myItem.Body := myItem.Body + 'const' + #13;
  myItem.Body := myItem.Body + '  // OlItemType constants' + #13;
  myItem.Body := myItem.Body + '  olMailItem = 0;' + #13;
  myItem.Body := myItem.Body + '  olAppointmentItem = 1;' + #13;
  myItem.Body := myItem.Body + '  olContactItem = 2;' + #13;
  myItem.Body := myItem.Body + '  olTaskItem  = 3;' + #13;
  myItem.Body := myItem.Body + '  olJournalItem = 4;' + #13;
  myItem.Body := myItem.Body + '  olNoteItem = 5;' + #13;
  myItem.Body := myItem.Body + '  olPostItem = 6;' + #13;
  myItem.Body := myItem.Body + '  // OlAttachmentType constants' + #13;
  myItem.Body := myItem.Body + '  olByValue = 1;' + #13;
  myItem.Body := myItem.Body + '  olByReference = 4;' + #13;
  myItem.Body := myItem.Body + '  olEmbeddedItem = 5;' + #13;
  myItem.Body := myItem.Body + '  olOLE = 6;' + #13;
  myItem.Body := myItem.Body + #13;
  myItem.Body := myItem.Body + 'var' + #13;
  myItem.Body := myItem.Body + '  myOlApp, myItem, myRecipient, myAttachments: OleVariant;' + #13;
  myItem.Body := myItem.Body + 'begin' + #13;
  myItem.Body := myItem.Body + '  myOlApp := CreateObject(''Outlook.Application'')' + #13;
  myItem.Body := myItem.Body + '  myItem := myOlApp.CreateItem(olMailItem)' + #13;
  myItem.Body := myItem.Body + '  myItem.Subject := ''This is the Subject''' + #13;
  myItem.Body := myItem.Body + '  myItem.Body := ''This is the body''' + #13;
  myItem.Body := myItem.Body + '  myRecipient :=
  myItem.Recipients.Add('recipientaddress@recipienthost.com')' + #13;
  myItem.Body := myItem.Body + '  myAttachments := myItem.Attachments' + #13;
  myItem.Body := myItem.Body + '  // Now let''s attach the files...' + #13;
  myItem.Body := myItem.Body + '  myAttachments.Add ''C:\blah.txt'', olByValue, 1,
    '' Blah.txt Attachment''' + #13;
  myItem.Body := myItem.Body + '  myItem.Send' + #13;
  myItem.Body := myItem.Body + '  myOlApp := VarNull;' + #13;
  myItem.Body := myItem.Body + '  myItem := VarNull;' + #13;
  myItem.Body := myItem.Body + '  myRecipient := VarNull;' + #13;
  myItem.Body := myItem.Body + '  myAttachments := VarNull;' + #13;
  myItem.Body := myItem.Body + 'end;' + #13;
  { Now let's attach the files... }
  myAttachments := myItem.Attachments;
  myAttachments.Add('C:\blah.txt', olByValue, 1, 'Blah.txt Attachment');
  myItem.Send;
  myOlApp := VarNull;
  myItem := VarNull;
  myRecipient := VarNull;
  myAttachments := VarNull;
end;

The way you do it, your string is recreated an shuffled around a lot of times. The way directly above, you'll only have one large string, being slowly filled with the text. So instead of

myItem.Body := #13;
myItem.Body := myItem.Body + #13;
myItem.Body := myItem.Body + 'Hello,' + #13;
myItem.Body := myItem.Body + 'This code created this message and ' +
' sent it and I didn''t even have' + #13;
{ etc... }

you could write

myItem.Body := #13 + #13 + 'Hello' + #13 + 'This code created this message and ' +
'sent it and I didn''t even have' + #13 +
{ etc... }


Solve 3:

uses
  Mapi;

procedure TForm1.Button1Click(Sender: TObject);
const
  MyToName = 'Name';
  MyToAddress = 'to@domain.com';
  MyCCAddress = 'cc@domain.com';
  MySubject = 'Subject';
  MyBody = 'Some' + #13#10 + 'Text';
  MyFileName = 'c:\config.sys';
  MySendError = 'Error sending mail';
var
  MyMapiMessage: TMapiMessage;
  MyRecipients: array of TMapiRecipDesc;
  MyAttachments: array of TMapiFileDesc;
begin
  {Recipient addresses}
  SetLength(MyRecipients, 2);
  FillChar(MyRecipients[0], Length(MyRecipients) * SizeOf(TMapiRecipDesc), 0);
  with MyRecipients[0] do
  begin
    ulRecipClass := MAPI_TO;
    lpszName := PChar(MyToName);
    lpszAddress := PChar(MyToAddress);
  end;
  with MyRecipients[1] do
  begin
    ulRecipClass := MAPI_CC;
    lpszAddress := PChar(MyCCAddress);
  end;
  {Attach a file}
  SetLength(MyAttachments, 1);
  FillChar(MyAttachments[0], SizeOf(MyAttachments), 0);
  MyAttachments[0].nPosition := Cardinal(-1);
  MyAttachments[0].lpszPathName := PChar('' + MyFileName);
  {Fill the message structure}
  FillChar(MyMapiMessage, SizeOf(TMapiMessage), 0);
  with MyMapiMessage do
  begin
    lpszSubject := PChar(MySubject);
    lpszNoteText := PChar(MyBody);
    nRecipCount := Length(MyRecipients);
    lpRecips := @MyRecipients[0];
    if Length(MyAttachments) > 0 then
    begin
      nFileCount := Length(MyAttachments);
      lpFiles := @MyAttachments[0];
    end;
  end;
  if MapiSendMail(0, Application.Handle, MyMapiMessage, MAPI_DIALOG or
    MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) <> 0 then
    MessageDlg(MySendError, mtError, [mbOK], 0);
end;


Solve 4:

procedure TForm1.Button1Click(Sender: TObject);
var
  App: _Application;
  Item: MailItem;
begin
  App := CoOutlookApplication.Create;
  Item := App.CreateItem(olMailItem) as MailItem;
  Item.Subject := 'My Subject';
  Item.To_ := 'nobody@nowhere.com';
  Item.Attachments.Add('C:\test.txt', EmptyParam, EmptyParam, EmptyParam);
  Item.Send;
end;