How to fix "send e-mail" via Delphi Winapi.Mapi? - delphi

Question

I've updating Microsoft Office from version 2016 to version 2019.
After that my Delphi-Program can't open new Outlook mail window.
The program uses SimpleMapi via Winapi.Mapi to start Outlook.
The Outlook App is setted as Standard-App for sending mails.
The windows registry don't contain the MAPI-Key in the standard like before.
I've tried to add the following MAPI Keys to the windows registry, but without success.
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows Messaging Subsystem]
"MAPI"="1"
"MAPIX"="1"
"OLEMessaging"="1"
"CMC"="1"
"MAPIXVER"="1.0.0.1"
"CMCDLLNAME32"="mapi32.dll"
The reason why I have tried this, is that Winapi.Mapi search in the HKLM\Software\Microsoft\Windows Messaging Subsystem for the MAPI keys to load the MAPI32.dll of the setted standard mail application.
The MAPI is allegedly not available if the Winapi.Mapi tried to load it.
A remark: The "mailto"-functionality works fine.
So my program works fine with the older versions of Microsoft Office like 2016 and earlier, but not with the version 2019.
The Question is: what is the reason for the failure? is the registry configuration a reason for that or maybe the obsolated Embarcadero lib?
I hope the problem description was clear enough.
Hope you can help me.

Answer 1

unit uAutomationSendMessage;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
function SendMessageViaOLE(Subject : WideString;
Body : WideString;
UseHtml : Boolean = False;
ShowModal : Boolean = True;
Recipients : TStringList = nil;
AttachList : TStringList = nil) : Integer;
function AutomationSendMessage(Subject : WideString;
Body : WideString;
UseHtml : Boolean = False;
ShowModal : Boolean = True;
recipients : TStringList = nil;
AttachList : TStringList = nil) : Integer; OverLoad;
function AutomationSendMessage(Subject : WideString;
Body : WideString;
UseHtml : Boolean = False;
ShowModal : Boolean = True;
recipients : String = '';
AttachFile : String = '') : Integer; OverLoad;
implementation
uses
OutlookSecMan,
Outlook2010,
ComObj,
ole;
procedure SleepForXXXMiliSecend(MiliSecunda : Integer);
Var
CurTime : Integer;
UntilMax : Integer;
begin
UntilMax := Trunc(MiliSecunda / 10);
if UntilMax < 5 then
UntilMax := 5;
For CurTime := 0 to UntilMax Do
begin
Sleep(05); {10 cose it work more then excepted}
Application.ProcessMessages;
end;
end;
function SendMessageViaOLE(Subject : WideString;
Body : WideString;
UseHtml : Boolean = False;
ShowModal : Boolean = True;
Recipients : TStringList = nil;
AttachList : TStringList = nil) : Integer;
const
olMailItem = 0;
var
OlSecurityManager: TOlSecurityManager;
CurItem : Integer;
Outlook : OLEVariant;
MailItem : Variant;
OLCreated : Boolean;
begin
Try
OlSecurityManager:= TOlSecurityManager.Create(Application);
OLCreated := False;
try
Outlook := GetActiveOleObject('Outlook.Application') ;
except
Outlook := CreateOleObject('Outlook.Application') ;
OLCreated := True;
end;
SleepForXXXMiliSecend(100);
MailItem := Outlook.CreateItem(olMailItem) ;
SleepForXXXMiliSecend(100);
//MailItem.Recipients.Add('johndoe#hotmail.com') ;
MailItem.Subject := Subject;
if UseHtml then
MailItem.HTMLBody := Body
else
MailItem.Body := Body;
if Assigned(Recipients) then
begin
for CurItem := 0 to Recipients.Count - 1 do
if Trim(Recipients.Strings[CurItem]) <> '' then
MailItem.Recipients.Add(Recipients.Strings[CurItem]);
end;
if Assigned(AttachList) then
begin
for CurItem := 0 to AttachList.Count - 1 do
if Trim(AttachList.Strings[CurItem]) <> '' then
MailItem.Attachments.Add(AttachList.Strings[CurItem]);
end;
MailItem.Display(False); //True=Send Immedeate
SleepForXXXMiliSecend(100);
If OLCreated Then
VarClear(Outlook);
Finally
OlSecurityManager.DisableOOMWarnings := False;
End;
end;
function AutomationSendMessage(Subject : WideString;
Body : WideString;
UseHtml : Boolean = False;
ShowModal : Boolean = True;
Recipients : TStringList = nil;
AttachList : TStringList = nil) : Integer;
const
olMailItem = 0;
olByValue = 1;
Var
CurTest : Integer;
CurItem : Integer;
//Outlook : OleVariant;
Outlook: Outlook2010.TOutlookApplication;
OlSecurityManager: TOlSecurityManager;
vMailItem : variant;
mRecipient, mSubject, mBody, mAttachement: String;
Begin
Result := -99;
Try
OlSecurityManager:= TOlSecurityManager.Create(Application);
//Try
// Outlook := GetActiveOleObject('Outlook.Application');
//Except;
// Outlook := CreateOleObject('Outlook.Application');
//End;
Outlook := TOutlookApplication.Create(nil);
OlSecurityManager.ConnectTo(Outlook.Application);
OlSecurityManager.DisableOOMWarnings := True;
vMailItem := Outlook.CreateItem(olMailItem);
SleepForXXXMiliSecend(20); // avoid Call was rejected by callee.
//vMailItem.Recipients.Add('test#hanibaal.co.il');
For CurTest := 0 To 10 Do
begin
Try
vMailItem.Subject := Subject;
Break;
Except;
// wait somw more for prevent - Call was rejected by callee.
SleepForXXXMiliSecend(20); // avoid Call was rejected by callee.
End;
end;
if UseHtml then
vMailItem.HTMLBody := Body
else
vMailItem.Body := Body;
//MailItem.Recipients.Add('someone#yahoo.com'); // Type=1 olTo
//MailItem.Recipients.Add('joesmoe#yahoo.com').Type := 2; // olCC
//MailItem.Recipients.Add('alice#yahoo.com').Type := 3; // olBCC
if Assigned(Recipients) then
begin
for CurItem := 0 to Recipients.Count - 1 do
if Trim(Recipients.Strings[CurItem]) <> '' then
vMailItem.Recipients.Add(Recipients.Strings[CurItem]);
end;
if Assigned(AttachList) then
begin
for CurItem := 0 to AttachList.Count - 1 do
if Trim(AttachList.Strings[CurItem]) <> '' then
vMailItem.Attachments.Add(AttachList.Strings[CurItem]);
end;
Try
IF ShowModal Then
begin
IF vMailItem.display(True) Then
begin
Result := 0 {Message sent}
end;
end
else
begin
//vMailItem.Send;
IF vMailItem.display(False) Then
begin
Result := 0 {Message sent}
end;
end;
Except
on e : System.SysUtils.Exception do
begin
Result := 1; {Message not sent}
ShowMessage('Sending mail fail - ' + e.Message);
end;
End;
Finally
OlSecurityManager.DisableOOMWarnings := False;
Try OlSecurityManager.Free; Except; End;
VarClear(vMailItem);
Outlook := nil;
end;
end;
function AutomationSendMessage(Subject : WideString;
Body : WideString;
UseHtml : Boolean = False;
ShowModal : Boolean = True;
recipients : String = '';
AttachFile : String = '') : Integer;
Var
recipientsList : TStringList;
AttachListList : TStringList;
begin
recipientsList := TStringList.Create;
AttachListList := TStringList.Create;
Try
recipientsList.Add(recipients);
AttachListList.Add(AttachFile);
result := AutomationSendMessage(Subject,
Body,
UseHtml,
ShowModal,
recipientsList,
AttachListList);
Finally
recipientsList.Free;
AttachListList.Free;
End;
end;
end.

Answer 2

Just came a cropper with this issue under windows 10/office 365
Add MAPI string value of '1' to this Key instead.
Computer\HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Windows Messaging Subsystem
restart application and should be back in business.