Navigation Menu Search PhysiologyWeb
PhysiologyWeb Logo Search PhysiologyWeb
   
— share —
Share on Facebook    Share on X    Share on LinkedIn    Share on Pinterest    Share on Reddit    Email    Copy URL
procedure TForm1.SearchForMicrosoftOutlookEmailsWithAttachments(Sender: TObject);
var
Count: Integer;
StartDate, EndDate: TDate;
OutlookFindString: String;
OutlookApplication, OutlookNameSpace, OutlookFolder, OutlookFolderEmailItems, OutlookMailItem: Variant;
begin
//be sure ComObj and Variants units are included in the "uses" clause

Count := 0;

StartDate := StrToDate('7/25/2022'); //start of date window
EndDate := StrToDate('7/31/2022'); //end date for search window
EndDate := EndDate + 1; //make the search inclusive for the specified window

OutlookFindString := '[ReceivedTime] >= "' + FormatDateTime('ddddd h:nn AMPM', StartDate) + '" and [ReceivedTime] < "' + FormatDateTime('ddddd h:nn AMPM', EndDate) + '"';

OutlookApplication := Null;
OutlookNameSpace := Null;
OutlookFolder := Null;
OutlookFolderEmailItems := Null;
OutlookMailItem := Null;

try
//create Outlook OLE
OutlookApplication := CreateOleObject('Outlook.Application');
except
OutlookApplication := Null;
//add error/exception handling code as desired
end;

If VarIsNull(OutlookApplication) = False then
begin
try
OutlookNameSpace := OutlookApplication.GetNameSpace('MAPI');
OutlookNameSpace.Logon('', '', False, True);
OutlookFolder := OutlookNameSpace.GetDefaultFolder(6); //6 is Inbox
OutlookFolderEmailItems := OutlookFolder.Items;

OutlookFolderEmailItems.Sort('[ReceivedTime]', False); //True = descending; False = ascending

try
OutlookMailItem := Null;
OutlookMailItem := OutlookFolderEmailItems.Find(OutlookFindString);
//reference
//https://docs.microsoft.com/en-us/office/vba/api/outlook.items.find
repeat
If (VarIsNull(OutlookMailItem) = False) and (VarIsEmpty(OutlookMailItem) = False) then
begin
//add code to handle emails as desired
//here we capture a summary of the emails found
//we will only look at those with one or more attachments
//be sure a Memo1 VCL object exists
If OutlookMailItem.Attachments.Count > 0 then
begin
Count := Count + 1;
Memo1.Lines.Add(IntToStr(Count) + ' | Sent: ' + DateTimeToStr(OutlookMailItem.ReceivedTime) + ' | From: ' + OutlookMailItem.SenderName);
end;
//refereces
//https://docs.microsoft.com/en-us/office/vba/api/outlook.mailitem
//https://docs.microsoft.com/en-us/office/vba/api/outlook.mailitem.attachments
end;
OutlookMailItem := Unassigned;
OutlookMailItem := OutlookFolderEmailItems.FindNext;
//reference
//https://docs.microsoft.com/en-us/office/vba/api/outlook.items.findnext
until (VarIsNull(OutlookMailItem) = True) or (VarIsEmpty(OutlookMailItem) = True);
except
//add error/exception handling code as desired
end;
finally
OutlookMailItem := Unassigned;
OutlookFolderEmailItems := Unassigned;
OutlookFolder := Unassigned;
OutlookNameSpace := Unassigned;
OutlookApplication := Unassigned;
end;
end;
end;




Posted: Saturday, July 30, 2022
Last updated: Tuesday, March 18, 2025
— share —
Share on Facebook    Share on X    Share on LinkedIn    Share on Pinterest    Share on Reddit    Email    Copy URL