Exchange Web Services has a ResolveNames() function that I can use to retrieve (among other things) the primary SMTP address for the Active Directory user that logged on to Exchange Server through EWS.
I am now programming through OLE against Outlook and would like the same functionality.
I have been browsing through the Outlook object model but can't find an appropriate object or method.
Does anyone know of an object/method that I can use to get the primary SMTP address?
Below is the current Delphi code that I use to connect to Outlook.
For the default user logging in (AUserSMTP='') it returns the OutlookApp COM Object (through GetActiveOleObject or CreateOleObject), a NameSpace (through GetNameSpace) and a Folder (through GetDefaultFolder) object, but I could not find where to go from there.
I thought lNameSpace.CurrentUser (a Recipient object) might lead somewhere, but its Address property only returns a string like '/o=TimeTell/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Recipients/cn=developer' without email address...
Any suggestions about the route to take?
function TDataModuleSyncOutlook.ConnectToOutlook(AUserSMTP: String = ''): Boolean;
var
lNameSpace, lRecipient: OleVariant;
begin
Result := false;
FWasCreated := False;
try
FOutlookApp := GetActiveOleObject(scxOutlookApp);
Result := True;
except
try
FOutlookApp := CreateOleObject(scxOutlookApp);
FWasCreated := True;
Result := True;
except
on E:Exception do ...
end;
end;
if Result then
begin
lNameSpace := FOutlookApp.GetNameSpace(scxNameSpace);
if AUserSMTP <> '' then // This part not applicable to the question
begin // Open shared calendar als er een expliciete gebruiker is opgegeven...
lRecipient := lNameSpace.CreateRecipient(AUserSMTP);
try
FCalendarFolder := lNameSpace.GetSharedDefaultFolder(lRecipient, olFolderCalendar);
except
on E:Exception do ...
end;
end
else // ... anders de default calendar folder openen
FCalendarFolder := lNameSpace.GetDefaultFolder(olFolderCalendar);
end;
FOleInitialized := Result;
if Result then TSyncLogger.LogAlways('Connected to Outlook') else TSyncLogger.LogAlways('Connection to Outlook failed');
end;
Try to use Application.Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress (you would of course need to check for nulls).
As for the account order, you can either use Extended MAPI and IOlkAccountManager.GetOrder (you can play with that object in OutlookSpy (I am its author) if you click IOlkAccountManager button) or you can use Redemption (I am also its author) and its RDOSession.Accounts.GetOrder method (see http://www.dimastr.com/redemption/RDOAccounts.htm). The first account in the returned collection will be the default one.
I found it. I have to go through the Accounts object in the namespace:
for i := 1 to lNameSpace.Accounts.Count do
if lNameSpace.Accounts.Item[i].AccountType = olExchange then
begin
lAccount := lNameSpace.Accounts.Item[i];
Break;
end;
if VarIsClear(lAccount) then
begin
DisConnectFromOutlook;
Exit;
end;
lLoginSMTP := lAccount.SmtpAddress;
The only thing I would still like is to determine the default account.
Related
I'm having trouble sending attachments via stream.
I use Indy 10.6.2 and Delphi Berlin.
The mail consists of html with attached images, plus one or more PDF files inserted directly from the database.
I don't get any errors in the process.
Mail is sent seamlessly, but attached PDFs are not received.
I look forward to comments
Msg := TIdMessage.Create(self);
try
Msg.ContentType := 'multipart/mixed';
Msg.From.Name := FromName;
Msg.From.Address := FromAddress;
Msg.Priority := mpHigh;
Msg.Subject := Asunto;
with TIdMessageBuilderHtml.Create do
try
if FMsgTxtPlnPac <> '' then
PlainText.Text := FMsgTxtPlnPac;
if FMsgHtmlPac <> '' then
begin
Html.Text := FMsgHtmlPac;
n := 0;
for s in FMsgHTMLFiles.Split([',']) do
begin
n := Succ(n);
c := 'img' + inttostr(n);
HTMLFiles.Add(s, c); // cid de imagen en HTML(cid:img1, cid:img2...)
end;
end;
if AttachFiles <> '' then
for s in AttachFiles.Split([',']) do
Attachments.Add(s);
// Attach from DB
while not dm.qryBlb.Eof do
begin
Attach := TIdAttachmentMemory.Create(Msg.MessageParts);
Attach.ContentType := 'application/pdf';
Attach.FileName := dm.qryBlb.FieldByName('nombre_archivo').AsString;
Attach.LoadFromStream(dm.GetDataBlbStrm('DATA_TXT')); // this ok in attach.datastream.size
Attach.CloseLoadStream;
dm.qryBlb.Next;
end;
FillMessage(Msg);
finally
Free;
end;
for s in FMailPac.Split([',']) do
begin
EmailAddress := Trim(s);
if EmailAddress <> '' then
begin
with Msg.recipients.Add do
begin
Address := EmailAddress;
end;
end;
end;
for s in MailCC.Split([',']) do
begin
EmailAddress := Trim(s);
if EmailAddress <> '' then
Msg.CCList.Add.Address := EmailAddress;
end;
for s in MailCCO.Split([',']) do
begin
EmailAddress := Trim(s);
if EmailAddress <> '' then
Msg.BccList.Add.Address := EmailAddress;
end;
finally
SMTP1.Send(Msg);
end;
TIdMessageBuilderHtml supports adding attachments via streams, as well as via files. However, those streams have to remain alive for the duration that the TIdCustomMessageBuilder.Attachments collection is populated, which is not an option in your case since you are looping through DB records one at a time, thus you would only be able to access 1 DB stream at a time.
You could create a local array/list of TMemoryStream objects, and then populate the TMessageBuilderHtml with those streams, but you will end up wasting a lot of memory that way since TIdMessageBuilderHtml would make its own copy of the TMemoryStream data. And there is no way to have TIdMessageBuilderHtml just use your TMemoryStream data as-is in a read-only mode (hmm, I wonder if I should add that feature!).
The reason why your manual TIdAttachmentMemory objects don't work is simply because TIdCustomMessageBuilder.FillMessage() clears the TIdMessage's body before then re-populating it, thus losing your attachments (and various other properties that you are setting manually beforehand).
You would have to add your DB attachments to the TIdMessage after FillMessage() has done its work first. But, then you risk TIdMessageBuilderHtml not setting up the TIdMessage structure properly since it wouldn't know your DB attachments exist.
On a side note, you are not using TIdAttachmentMemory correctly anyway. Do not call its CloseLoadStream() method if you have not called its OpenLoadStream() method first. Calling its LoadFromStream() method is enough in this case (or, you can even pass the TStream to TIdAttachmentMemory's constructor). Do note, however, that you are leaking the TStream returned by dm.GetDataBlbStrm().
So, in this case, you are probably better off simply populating the TIdMessage manually and not use TIdMessageBuilderHtml at all. Or, you could derive a new class from TIdMessageBuilderHtml (or TIdCustomMessageBuilder directly) and override its virtual FillBody() and FillHeaders() methods to take your DB streams into account.
I wrote some code to read emails from Outlook Inbox and collect attachments.
This is working just fine. I am using Outlook 2019/Office 365.
I can use both Mail.SenderEmailAddress or Mail.Sender.Address to get the email address of the sender.
When deploying my application to another computer with Outlook 2016, I get this error:
EOleError: Method 'Sender' not supported by automation object
Same for Mail.SenderEmailAddress
Outlook 2016 or 2019 have the same code stream. See Outlook versions, build numbers and other trivia.
Could you help understanding why I get such error on my client's computer and how can I fix that problem?
Are you aware of a free/commercial library or components that could do that smoothly?
This is somehow linked with my other question about Sending Outlook Email with Delphi.
try
Outlook:=GetActiveOleObject('Outlook.Application') ;
except
Outlook:=CreateOleObject('Outlook.Application') ;
end;
try
oNameSpace := Outlook.GetNamespace('MAPI');
oNameSpace.Logon;
Inbox:= oNameSpace.GetDefaultFolder(6);
iNbMail:= Inbox.Items.Count;
for i:= iNbMail downto 1 do
begin
if VarIsNull(Inbox.Items[i]) or VarIsEmpty(Inbox.Items[i]) then
Continue;
Mail:= Inbox.Items[i];
EmailAddress:= Mail.Sender.Address;
// EmailAddress:= Mail.SenderEmailAddress;
UnReadFlag:= Mail.UnRead;
iNbAttach := Mail.Attachments.Count;
for j := iNbAttach downto 1 do
begin
Attachment:= Mail.Attachments[j];
if ExtractFileExt(Attachment.FileName) = '.pdf' then
begin
SaveName:= TPath.Combine(InboxFolder, Attachment.FileName);
Attachment.SaveAsFile(SaveName);
end;
end;
Mail.UnRead:= False;
end;
finally
Outlook:= Unassigned;
oNameSpace:= Unassigned;
Inbox:= Unassigned;
Mail:= Unassigned;
end;
Inbox folder in Outlook is not restricted to contain only mail messages. When iterating through its items you can encounter various item classes like MailItem, PostItem, MeetingItem, TaskRequestItem and many others. All of these items support different sets of properties and not all of them have Sender, SenderEmailAddress or Attachments property. If you're interested only in mail items then you need to check item's Class property:
const
olMail = $0000002B;
{ ... }
for i := iNbMail downto 1 do
begin
Mail := Inbox.Items[i];
if Mail.Class <> olMail then
Continue;
{ here we can assume we're working with MailItem instance }
end;
I doubt that Outlook ever returns null or empty item, so the check you do in your code is pointless. If you're interested in other item classes then check out OlObjectClass enumeration.
I'm not sure why you prefer to use late-binding, because Delphi already comes with imported type library Outlook2010.pas to automate Outlook in strongly typed manner. The library is located in OCX\Servers subfolder of installation folder. In case you need to support pre-2010 Outlook versions you can use unit OutlookXP or even Outlook2000 instead. The code fore iterating mail items using the type library could look like this:
uses
System.SysUtils, System.Variants, Winapi.ActiveX, Outlook2010;
function GetOutlookApplication: OutlookApplication;
var
ActiveObject: IUnknown;
begin
if Succeeded(GetActiveObject(OutlookApplication, nil, ActiveObject)) then
Result := ActiveObject as OutlookApplication
else
Result := CoOutlookApplication.Create;
end;
procedure ProcessInboxItems;
var
Outlook: OutlookApplication;
Inbox: Folder;
Index: Integer;
LItems: Items;
LMailItem: MailItem;
begin
Outlook := GetOutlookApplication;
Outlook.Session.Logon(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
Inbox := Outlook.Session.GetDefaultFolder(olFolderInbox);
LItems := Inbox.Items;
for Index := LItems.Count downto 1 do
begin
if Supports(LItems.Item(Index), MailItem, LMailItem) then
begin
{ do whatever you wish with LMailItem }
end;
end;
end;
This is the code with which we start Outlook and open a shared calendar folder for a user defined by primary SMTP address AUserSMTP:
const
scxOutlookApp = 'outlook.application';
scxNameSpace = 'MAPI';
olFolderCalendar = $00000009; // Outlook default calendar folder
function TDataModuleSyncOutlook.ConnectToOutlook(AUserSMTP: String = ''): Boolean;
var
lRecipient,
lVar : OleVariant;
lLog,
lLoginSMTP: String;
begin
Result := false;
FWasCreated := False;
try
FOutlookApp := GetActiveOleObject(scxOutlookApp);
Result := True;
except
try
FOutlookApp := CreateOleObject(scxOutlookApp);
FWasCreated := True;
Result := True;
except
on E:Exception do TSyncLogger.LogError(E.Message);
end;
end;
if Result then
begin
FNameSpace := FOutlookApp.GetNamespace(scxNameSpace);
// From http://stackoverflow.com/questions/18053110/retrieve-outlook-logged-in-user-smtp-address-after-connecting-through-ole/
lLog := Format('Connected to Outlook; Application.DefaultProfilename: %s, Application.Name: %s, Application.Version: %s, NameSpace.CurrentProfileName: %s, NameSpace.ExchangeMailboxServerName: %s, NameSpace.Type: %s',
[FOutlookApp.DefaultProfileName,
FOutlookApp.Name,
FOutlookApp.Version,
FNameSpace.CurrentProfileName,
FNameSpace.ExchangeMailboxServerName,
FNameSpace.Type]);
TSyncLogger.LogDebug(lLog);
lVar := FOutlookApp.Session; // NameSpace object for the current session
if not VarIsClear(lVar) then lVar := lVar.CurrentUser; // Recipient object for the currently logged-on user
if not VarIsClear(lVar) then lVar := lVar.AddressEntry; // AddressEntry object for the recipient
if not VarIsClear(lVar) then lVar := lVar.GetExchangeUser; // Returns an ExchangeUser object that represents the AddressEntry
if not VarIsClear(lVar) then lVar := lVar.PrimarySmtpAddress; // String representing the SMTP address for the ExchangeUser
if not VarIsClear(lVar) then
begin
lLoginSMTP := FOutlookApp.Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress;
TSyncLogger.LogDebug('Primary Exchange SMTP address detected as: ' + lLoginSMTP);
end
else
begin
TSyncLogger.LogError('No Exchange Server account found in Outlook');
DisConnectFromOutlook;
Exit;
end;
if LowerCase(AUserSMTP) <> Lowercase(lLoginSMTP) then
begin // Open shared calendar if it is a different user
lRecipient := FNameSpace.CreateRecipient(AUserSMTP);
try
FCalendarFolder := FNameSpace.GetSharedDefaultFolder(lRecipient, olFolderCalendar);
lLog := Format('Logging in as different user (%s), created recipient for %s, GetSharedDefaultFolder folder path = %s',[AUserSMTP,lRecipient.Address,FCalendarFolder.FolderPath]);
TSyncLogger.LogDebug(lLog);
except
on E:Exception do
begin
Result := false;
TSyncLogger.LogError(Format('Cannot open shared calendar for %s',[AUserSMTP])); // <== error here
end;
end;
end
else // ... otherwise open default calendar folder
begin
FCalendarFolder := FNameSpace.GetDefaultFolder(olFolderCalendar);
TSyncLogger.LogDebug('Opened default calendar folder, folder path = ' + FCalendarFolder.FolderPath);
end;
end;
FOleInitialized := Result;
if Result then TSyncLogger.LogDebug('Connected to Outlook') else TSyncLogger.LogAlways('Connection to Outlook failed');
end;
We have an issue at a company that changed domain names, and I think that is the reason:
Initially user#olddomain.com had granted editor access to admin#olddomain.com for their calendar (or the administrator had taken access).
The company changed name and users primary SMTP addresses were changed from #olddomain.com to #newdomain.com.
The code runs on a machine where admin#olddomain.com is still the logged in user, so Outlook starts with that account.
When admin#olddomain.com starts Outlook, he can edit and delete appointments in the calendar of user#newdomain.com.
However, our code gives the 'Cannot open shared calendar' error (see 'error here') when we call the above procedure with either user#olddomain.com or user#newdomain.com.
While debugging the issue with an admin, he changed the primary SMTP for our test user back to user#olddomain.com, but the code still failed.
Questions:
Can anyone confirm that my suspicion of a cross-domain issue is correct? Does this sound familiar?
Could it be that our opening the default olFolderCalendar no longer is the correct way (because of the domain name change)?
Other things that are suspect in the code?
Other things that we could test or try to make this work?
Two things just cross my mind while writing this and I have not tested/verified them yet:
I am assuming that admin#newdomain.com is now also the primary SMTP for admin, like everyone else.
What if the Outlook profile on that machine is changed so that admin#newdomain.com starts Outlook?
If I start Outlook manually and then run my program that talks to it through OLE, all my (renamed) categories with colors are visible:
If I do not start Outlook manually, but have it startup from code, then start it up manually as well, I suddenly miss my renamed category info:
In an individual appointment we see that the renamed categories still exist:
but the link between these category names and some 'master list' (?) that defines the colors seems to be missing.
Luckily my code does not seem to have a problem, the categories it retrieves for an appointment are the renamed ones.
But I would like to change the behavior under point 2 - when my program is running and I open Outlook it's very nice for debugging if I see the correct data in Outlook ;-)
Here is the code that starts Outlook:
function TDataModuleSyncOutlook.ConnectToOutlook(AUserSMTP: String = ''): Boolean;
var
lRecipient,
lVar : OleVariant;
lLog,
lLoginSMTP: String;
begin
Result := false;
FWasCreated := False; // Breakpoint 'Ignore subsequent exceptions'
try
FOutlookApp := GetActiveOleObject(scxOutlookApp); // Application object. This code fails if Outlook is not yet running...
Result := True;
except
try
FOutlookApp := CreateOleObject(scxOutlookApp); // ... and then this creates the Outlook instance
FWasCreated := True;
Result := True;
except
on E:Exception do TSyncLogger.LogError(E.Message);
end;
end;
if Result then // Breakpoint 'Handle subsequent exceptions'
begin
FNameSpace := FOutlookApp.GetNamespace(scxNameSpace);
// Oplossing uit http://stackoverflow.com/questions/18053110/retrieve-outlook-logged-in-user-smtp-address-after-connecting-through-ole/
lVar := FOutlookApp.Session; // NameSpace object for the current session
if not VarIsClear(lVar) then lVar := lVar.CurrentUser; // Recipient object for the currently logged-on user
if not VarIsClear(lVar) then lVar := lVar.AddressEntry; // AddressEntry object for the recipient
if not VarIsClear(lVar) then lVar := lVar.GetExchangeUser; // Returns an ExchangeUser object that represents the AddressEntry
if not VarIsClear(lVar) then lVar := lVar.PrimarySmtpAddress; // String representing the SMTP address for the ExchangeUser
if not VarIsClear(lVar) then
begin
lLoginSMTP := FOutlookApp.Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress;
TSyncLogger.LogDetail('Primary Exchange SMTP address detected as: ' + lLoginSMTP);
end
else
begin
TSyncLogger.LogError(sErrNoExchangeAccount);
DisConnectFromOutlook;
Exit;
end;
if LowerCase(AUserSMTP) <> Lowercase(lLoginSMTP) then
begin // Open shared calendar for different user. This does not apply in my test case
lRecipient := FNameSpace.CreateRecipient(AUserSMTP);
try
FCalendarFolder := FNameSpace.GetSharedDefaultFolder(lRecipient, olFolderCalendar);
lLog := Format('Logging in as different user (%s), created recipient for %s, GetSharedDefaultFolder folder path = %s',[AUserSMTP,lRecipient.Address,FCalendarFolder.FolderPath]);
TSyncLogger.LogAlways(lLog);
except
on E:Exception do
begin
Result := false;
TSyncLogger.LogError(Format(sErrOpenGedeeldeAgenda,[AUserSMTP]));
end;
end;
end
else // ... otherwise open default calendar folder
begin
FCalendarFolder := FNameSpace.GetDefaultFolder(olFolderCalendar);
TSyncLogger.LogDetail('Opened default calendar folder, folder path = ' + FCalendarFolder.FolderPath);
end;
end;
FOleInitialized := Result;
if Result then TSyncLogger.LogDetail('Connected to Outlook') else TSyncLogger.LogAlways('Connection to Outlook failed');
end;
Any ideas/suggestions what to do?
Additional info:
Outlook 2007 connected to Exchange 2013 RTM, under Win7-64
I have several mail profiles set up for this computer, the one for connecting to Exchange 2013 is set up as the default profile that Outlook starts with. Every time Outlook starts (also from code) I get prompted for the password.
Keep in mind that the categories are stored on the per store basis. Do both items come from the same store? Or is one of them residing in a delegate mailbox?
I have a multi user Delphi program which needs a shared folder over network to store data. I want the program changes the files in that folder but not normal users (who can see this folder) or network viruses...
I want to protect this folder with a password (windows 7) but I need to write new files or edit existing files via my program and I don't know how to do this.
Briefly I need to connect and disconnect to a shared folder via code like this
ConnectToFolder(\\myServerMachine\mySharedfolder username:me password:myPassword);
disConnectToFolder(\\myServerMachine\mySharedfolder username:me password:myPassword);
Is this possible?
Something like this would probably do the trick
function ConnectShare(Drive, RemotePath, UserName, Password : String):Integer;
var
NRW : TNetResource;
begin
with NRW do
begin
dwType := RESOURCETYPE_ANY;
if Drive <> '' then
lpLocalName := PChar(Drive)
else
lpLocalName := nil;
lpRemoteName := PChar(RemotePath);
lpProvider := '';
end;
Result := WNetAddConnection2(NRW, PChar(Password), PChar(UserName), 0);
end;
function DisconnectShare(Drive : String):Integer;
begin
Result := WNetCancelConnection2(PChar(Drive), 0, false);
end;