To send emails I use the SendEmail function:
function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;
type
TAttachAccessArray = array [0..0] of TMapiFileDesc;
PAttachAccessArray = ^TAttachAccessArray;
var
MapiMessage: TMapiMessage;
Receip, ComCopia: TMapiRecipDesc;
Attachments: PAttachAccessArray;
AttachCount: Integer;
i1: integer;
FileName: string;
dwRet: Cardinal;
MAPI_Session: Cardinal;
WndList: Pointer;
aRecep: Array of TMapiRecipDesc;
iRecipC, iCont: Integer;
sAuxCCo, sCCo, sTO: String;
begin
dwRet := MapiLogon(Handle, PAnsiChar(''), PAnsiChar(''), MAPI_LOGON_UI or MAPI_NEW_SESSION, 0, @MAPI_Session);
if (dwRet <> SUCCESS_SUCCESS) then
begin
MessageBox(Handle, PChar('Error while trying to send email'#10+SysErrorMessage(GetLastError)), PChar('Error'), MB_ICONERROR or MB_OK);
end
else
begin
AttachCount := 0;
Attachments := nil;
try
FillChar(MapiMessage, SizeOf(MapiMessage), #0);
FillChar(Receip, SizeOf(Receip), #0);
FillChar(ComCopia, SizeOf(ComCopia), #0);
iRecipC := 0;
if Mail.Values['to'] <> '' then
begin
sAuxCCo := Mail.Values['to'];
if (sAuxCCo[Length(sAuxCCo)] <> ';') then
sAuxCCo := sAuxCCo + ';';
while (Pos(';',sAuxCCo)) > 0 do
begin
sTO := sTO + Copy(sAuxCCo,1,Pos(';',sAuxCCo));
Delete(sAuxCCo,1,Pos(';',sAuxCCo));
Inc(iRecipC);
end;
end;
if Mail.Values['CCo'] <> '' then
begin
sAuxCCo := Mail.Values['CCo'];
if (sAuxCCo[Length(sAuxCCo)] <> ';') then
sAuxCCo := sAuxCCo + ';';
while (Pos(';',sAuxCCo)) > 0 do
begin
sCCo := sCCo + Copy(sAuxCCo,1,Pos(';',sAuxCCo));
Delete(sAuxCCo,1,Pos(';',sAuxCCo));
Inc(iRecipC);
end;
end;
SetLength(aRecep, iRecipC);
iCont := 0;
if sTO <> '' then
begin
while ((sTO) <> '') do
begin
sAuxCCo := Copy(sTO,1,Pos(';',sTO)- 1);
aRecep[iCont].ulReserved := 0;
aRecep[iCont].ulRecipClass := MAPI_TO;
aRecep[iCont].lpszName := StrNew(PAnsiChar(AnsiString(sAuxCCo)));
aRecep[iCont].lpszAddress := StrNew(PAnsiChar(AnsiString('SMTP:' + sAuxCCo)));
aRecep[iCont].ulEIDSize := 0;
Delete(sTO,1,Pos(';',sTO));
Inc(iCont);
end;
end;
if sCCo <> '' then
begin
while ((sCCo) <> '') do
begin
sAuxCCo := Copy(sCCo,1,Pos(';',sCCo)- 1);
aRecep[iCont].ulReserved := 0;
aRecep[iCont].ulRecipClass := MAPI_BCC;
aRecep[iCont].lpszName := StrNew(PAnsiChar(AnsiString(sAuxCCo)));
aRecep[iCont].lpszAddress := StrNew(PAnsiChar(AnsiString('SMTP:' + sAuxCCo)));
aRecep[iCont].ulEIDSize := 0;
Delete(sCCo,1,Pos(';',sCCo));
Inc(iCont);
end;
end;
AttachCount := 0;
for i1 := 0 to MaxInt do
begin
if Mail.Values['attachment' + IntToStr(i1)] = '' then
break;
Inc(AttachCount);
end;
if AttachCount > 0 then
begin
GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);
for i1 := 0 to AttachCount - 1 do
begin
FileName := Mail.Values['attachment' + IntToStr(i1)];
Attachments[i1].ulReserved := 0;
Attachments[i1].flFlags := 0;
Attachments[i1].nPosition := ULONG($FFFFFFFF);
Attachments[i1].lpszPathName := StrNew(PAnsiChar(AnsiString(FileName)));
Attachments[i1].lpszFileName := StrNew(PAnsiChar(AnsiString(ExtractFileName(FileName))));
Attachments[i1].lpFileType := nil;
end;
end;
with MapiMessage do
begin
ulReserved := 0;
lpszSubject := StrNew(PAnsiChar(AnsiString(Mail.Values['subject'])));
lpszNoteText := StrNew(PAnsiChar(AnsiString(Mail.Values['body'])));
lpszMessageType := Nil;
lpszDateReceived := Nil;
lpszConversationID := Nil;
flFlags := 0;
lpOriginator := Nil;
nRecipCount := iRecipC;
lpRecips := @aRecep[0];
nFileCount := AttachCount;
lpFiles := @Attachments[0];
end;
WndList := DisableTaskWindows(0);
try
Result := MapiSendMail(MAPI_Session, Handle, MapiMessage, MAPI_DIALOG, 0);
finally
EnableTaskWindows( WndList );
end;
finally
for i1 := 0 to AttachCount - 1 do
begin
StrDispose(Attachments[i1].lpszPathName);
StrDispose(Attachments[i1].lpszFileName);
end;
if Assigned(MapiMessage.lpszSubject) then
StrDispose(MapiMessage.lpszSubject);
if Assigned(MapiMessage.lpszNoteText) then
StrDispose(MapiMessage.lpszNoteText);
if Assigned(Receip.lpszAddress) then
StrDispose(Receip.lpszAddress);
if Assigned(Receip.lpszName) then
StrDispose(Receip.lpszName);
MapiLogOff(MAPI_Session, Handle, 0, 0);
end;
end;
end;
Office 2010 works fine, but Office 2013 does not work anymore. The error pops up right after processing the first line, generating the message:
MessageBox(Handle, PChar('Error while trying to send email'#10+SysErrorMessage(GetLastError)), PChar('Error'), MB_ICONERROR or MB_OK);
Does anyone know how to solve it?