Delphi:通过 Outlook 发送带有多个附件的电子邮件
Delphi: Send email through Outlook with multiple attachments
各位专家大家好,
procedure TForm1.domail(Sender: TObject; fromname, fromadd, sub, toadd, thedocdone, theacc: string; body: widestring);
const
olMailItem = 0;
var
Outlook: OLEVariant;
vmailitem: variant;
Attachment: TIdAttachment;
savetofol: string;
begin
try
Outlook := GetActiveOleObject('Outlook.Application');
except
Outlook := CreateOleObject('Outlook.Application');
end;
vmailitem := Outlook.CreateItem(olMailItem);
vmailitem.Recipients.Add(toadd);
vmailitem.ReplyRecipients.Add('email@email.com');
vmailitem.Subject := sub;
vmailitem.body := 'SENT: ' + formatdatetime('dd mmmm yyyy - hh:nn am/pm', now) + #13#10 + body;
vmailitem.ReadReceiptRequested := true;
vmailitem.importance := 2;
if thedocdone <> 'NIL' then
begin
vmailitem.Attachments.Add(thedocdone, 1, 1, 'SBSA_' + theacc);
if ansipos('string1', lowercase(toadd)) <> 0 then
begin
vmailitem.Attachments.Add('*manual path', 1, 2, '*manual name');
Memo1.Lines.Add('Adding consent letter to mail...');
end;
if ansipos('string2', lowercase(toadd)) <> 0 then
begin
vmailitem.Attachments.Add('*manual path', 1, 2, '*manual name');
Memo1.Lines.Add('Adding consent letter to mail...');
end;
savetofol := extractfilepath(thedocdone) + copy(extractfilename(thedocdone), 0, length(extractfilename(thedocdone)) - 8);
vmailitem.saveas(savetofol + '_eml.doc', 4); // ^ +'.doc'
end;
// vmailitem.clear;
vmailitem.Send;
Outlook := Unassigned;
end;
通过上面的代码,我可以附加到 outlook 并发送电子邮件并将附件附加到该邮件...
我的问题是它不会附加第二个附件... ???我已经尝试了使用不同方法的各种方法,但我就是无法将第二个附件附加到邮件...
请帮忙...
参见Attachments Object (Outlook):
To ensure consistent results, always save an item before adding or
removing objects in the Attachments collection of the item.
错误:
vmailitem.Attachments.Add();
vmailitem.Attachments.Add();
vmailitem.Attachments.Add();
右:
vmailitem.Attachments.Add();
vmailitem.save;
vmailitem.Attachments.Add();
vmailitem.save;
vmailitem.Attachments.Add();
vmailitem.save;
各位专家大家好,
procedure TForm1.domail(Sender: TObject; fromname, fromadd, sub, toadd, thedocdone, theacc: string; body: widestring);
const
olMailItem = 0;
var
Outlook: OLEVariant;
vmailitem: variant;
Attachment: TIdAttachment;
savetofol: string;
begin
try
Outlook := GetActiveOleObject('Outlook.Application');
except
Outlook := CreateOleObject('Outlook.Application');
end;
vmailitem := Outlook.CreateItem(olMailItem);
vmailitem.Recipients.Add(toadd);
vmailitem.ReplyRecipients.Add('email@email.com');
vmailitem.Subject := sub;
vmailitem.body := 'SENT: ' + formatdatetime('dd mmmm yyyy - hh:nn am/pm', now) + #13#10 + body;
vmailitem.ReadReceiptRequested := true;
vmailitem.importance := 2;
if thedocdone <> 'NIL' then
begin
vmailitem.Attachments.Add(thedocdone, 1, 1, 'SBSA_' + theacc);
if ansipos('string1', lowercase(toadd)) <> 0 then
begin
vmailitem.Attachments.Add('*manual path', 1, 2, '*manual name');
Memo1.Lines.Add('Adding consent letter to mail...');
end;
if ansipos('string2', lowercase(toadd)) <> 0 then
begin
vmailitem.Attachments.Add('*manual path', 1, 2, '*manual name');
Memo1.Lines.Add('Adding consent letter to mail...');
end;
savetofol := extractfilepath(thedocdone) + copy(extractfilename(thedocdone), 0, length(extractfilename(thedocdone)) - 8);
vmailitem.saveas(savetofol + '_eml.doc', 4); // ^ +'.doc'
end;
// vmailitem.clear;
vmailitem.Send;
Outlook := Unassigned;
end;
通过上面的代码,我可以附加到 outlook 并发送电子邮件并将附件附加到该邮件...
我的问题是它不会附加第二个附件... ???我已经尝试了使用不同方法的各种方法,但我就是无法将第二个附件附加到邮件...
请帮忙...
参见Attachments Object (Outlook):
To ensure consistent results, always save an item before adding or removing objects in the Attachments collection of the item.
错误:
vmailitem.Attachments.Add();
vmailitem.Attachments.Add();
vmailitem.Attachments.Add();
右:
vmailitem.Attachments.Add();
vmailitem.save;
vmailitem.Attachments.Add();
vmailitem.save;
vmailitem.Attachments.Add();
vmailitem.save;