Watch, Follow, &
Connect with Us

Please visit our new home
community.embarcadero.com.


Welcome, Guest
Guest Settings
Help

Thread: Ole broken in windows 10


This question is not answered. Helpful answers available: 2. Correct answers available: 1.


Permlink Replies: 0 Threads: [ Previous | Next ]
Damon Theis

Posts: 4
Registered: 12/22/17
Ole broken in windows 10  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Mar 20, 2018 8:27 AM
I have some existing code to attached a pdf to an email in outlook and save the user from all the extra steps to do it manually. This code is broken in windows 10. Can anyone lend some advice? No errors, i just doesn't do anything with outlook. Have tried both 2013 and 365 2016 on win 10 with no luck. Works fine on win 7 with 365 2016/2013.
The function and procedure in use are below.

function GetFileListDataObject(const Directory: string; Files:
TStrings):
IDataObject;
type
PArrayOfPItemIDList = ^TArrayOfPItemIDList;
TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
Malloc: IMalloc;
Root: IShellFolder;
FolderPidl: PItemIDList;
Folder: IShellFolder;
p: PArrayOfPItemIDList;
chEaten: ULONG;
dwAttributes: ULONG;
FileCount: Integer;
i: Integer;
begin
Result := nil;
if Files.Count = 0 then
Exit;
OleCheck(SHGetMalloc(Malloc));
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.ParseDisplayName(0, nil,
PWideChar(WideString(Directory)),
chEaten, FolderPidl, dwAttributes));
try
OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
Pointer(Folder)));
FileCount := Files.Count;
p := AllocMem(SizeOf(PItemIDList) * FileCount);
try
for i := 0 to FileCount - 1 do
begin
OleCheck(Folder.ParseDisplayName(0, nil,
PWideChar(WideString(Files[i])), chEaten, p^[i],
dwAttributes));
end;
OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
nil,
Pointer(Result)));
finally
for i := 0 to FileCount - 1 do
begin
if p^[i] <> nil then
Malloc.Free(p^[i]);
end;
FreeMem(p);
end;
finally
Malloc.Free(FolderPidl);
end;
end;

procedure TForm1.Crpe1ExecuteEnd(Sender: TObject);
var
SelFileList: TStrings;
I: Integer;
DataObject: IDataObject;
Effect: Integer;
CLSID_SendMail: TGUID;
DT: IDropTarget;
P: TPoint;
begin
//if not fileexists('C:\POTempFiles\pdfpo_Report'+edit1.text+'.pdf') then showmessage('file not ready');
//try and email pdf for po
filelistbox1.Directory := 'C:\POTempFiles';
CLSID_SendMail := StringToGUID('{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}');
with FileListBox1 do
begin
SelFileList := TStringList.Create;
try
SelFileList.Capacity := SelCount;
for i := 0 to FileListBox1.Items.Count - 1 do
//showmessage('item is '+filelistbox1.items[i]);
if filelistbox1.items[i] = 'pdfpo_Report'+edit1.text+'.pdf' then
begin
SelFileList.Add(filelistbox1.Items[i]);
//showmessage('added file '+filelistbox1.Items[i]);
end;
DataObject := GetFileListDataObject(Directory, SelFileList);
finally
SelFileList.Free;
end;
Effect := DROPEFFECT_NONE;
CoCreateInstance(CLSID_SendMail, nil, CLSCTX_ALL, IDropTarget, DT);
DT.DragEnter(DataObject, MK_LBUTTON, P, Effect);
DT.Drop(DataObject, MK_LBUTTON, P, Effect);
end;
button1.caption := 'SEND email attachement '+'pdfpo_Report'+edit1.text+'.pdf'+' before closing this window.';
button1.enabled := false;
end;
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02