Send an email with an attachment (Views: 708)
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; |