Delphi通过OleVariant调用Outlook发送内嵌图片邮件失败求助

你的代码存在三个核心问题，导致图片无法正常内嵌显示：

1. HTML语法错误 #

原HTML里的<bodystyle和<fontcolor缺少空格，邮件客户端无法解析正确的样式标签，修正后的HTML应该是：

b := '<html><body style=' +
     'font-family:"Tahoma";font-style:normal;font-weight:normal;font-size:8pt' +
     '><font color="#000000">Hello world<IMG src="cid:1" width="606" height="606" ></font></body></html>';

2. 附件属性设置顺序错误 #

必须先添加附件并配置CID属性，再设置邮件的HTMLBody。Outlook需要先识别到带CID的附件，才能关联HTML中的引用。

3. 未设置附件隐藏属性 #

需要添加PR_ATTACHMENT_HIDDEN（0x7FFE000B）属性，标记附件为内嵌资源，避免被显示为普通附件。

修正后的完整代码 #

unit unit1;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, OutlookXP, comobj,  System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, system.Diagnostics;

type
 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private-Deklarationen }
 public
   { Public-Deklarationen }
 end;

 TOutlookEmail = class
 private
   FOutlookApp: OleVariant;
 public
   constructor Create;
   destructor Destroy; override;
   procedure SendEmailWithEmbeddedImage(const aRecipient, aSubject, aBody, aImagePath: string);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 b : String;
 mailOut : TOutlookEmail;
begin
 mailout := TOutlookEmail.Create;
 
 // 修正HTML语法错误
 b := '<html><body style=' +
      'font-family:"Tahoma";font-style:normal;font-weight:normal;font-size:8pt' +
      '><font color="#000000">Hello world<IMG src="cid:1" width="606" height="606" ></font></body></html>';

 mailout.SendEmailWithEmbeddedImage('xxx@googlemail.com', 'Test', b, 'C:\Delphi\1.png');
 mailout.Free; // 补充对象释放，避免内存泄漏
end;

constructor TOutlookEmail.Create;
begin
 inherited;
 FOutlookApp := CreateOleObject('Outlook.Application');
end;

destructor TOutlookEmail.Destroy;
begin
 FOutlookApp := Unassigned;
 inherited;
end;

procedure TOutlookEmail.SendEmailWithEmbeddedImage(const aRecipient, aSubject, aBody,
 aImagePath: string);
const
  PR_ATTACH_CONTENT_ID = 'http://schemas.microsoft.com/mapi/proptag/0x3712001F';
  PR_ATTACHMENT_HIDDEN = 'http://schemas.microsoft.com/mapi/proptag/0x7FFE000B';
var
 MailItem,
 Attachment: OleVariant;
begin
   MailItem := FOutlookApp.CreateItem(0);

   MailItem.Subject := ASubject;
   MailItem.To := aRecipient;
   mailitem.BodyFormat := olFormatHTML;

   // 先添加附件并配置属性，再设置HTMLBody
   if FileExists(aImagePath) then
   begin
     Attachment := MailItem.Attachments.Add(aImagePath);
     // 设置CID，与HTML中的cid:1对应
     Attachment.PropertyAccessor.SetProperty(PR_ATTACH_CONTENT_ID, '<1>');
     // 标记附件为隐藏，避免显示为普通附件
     Attachment.PropertyAccessor.SetProperty(PR_ATTACHMENT_HIDDEN, True);
   end;

   // 最后设置HTMLBody
   MailItem.htmlBody := aBody;

   MailItem.Send;
   MailItem := Unassigned;
end;

end.

额外注意事项 #

• 确保Outlook允许OLE自动化调用，部分版本可能需要在信任中心开启相关权限
• 测试时可先用MailItem.Display代替Send，直观检查邮件内容是否正确
• 若有多张内嵌图片，需为每张图片设置唯一CID（如<2>、<3>），并对应HTML中的cid:2、cid:3

内容的提问来源于stack exchange，提问作者sausagerus