Modify Single Email in Outlook Drafts subfolder

[g_speran]

Hello All,
I was wondering if I can get some assistance?
I got most of my code working where i can extrapolate information from the excel spreadsheet
But i need some assistance on code for modifying an email in the outlook drafts folder

Task: Modify an email that is in a subfolder (Financial) under Drafts
There should be one ore more of the EXACT same draft emails in this directory
- If one does not exist, throw a msgbox and exit sub
Need to Change the To line and add an attachment to ONLY ONE of the draft emails in this directory
Environment: Microsoft® Outlook® for Microsoft 365 MSO (Version 2308 Build 16.0.16731.20542) 64-bit Outlook Account: [username]@[company].com
Request: go straight to the [username]@[company].com\Drafts\Financials folder and modify ONE of the draft emails

I have been skewering the net for code to modify Only one Draft email in the directory but coming up empty. Everything seems to loop through the entire drafts directory
and modify/send all draft emails.

I have located the following on this message board, but each has it pros and cons.
I've tried modifications, but being relativity new to VBA, i am striking out

Is it possible to loop through a folder in Outlook using VBA?
Cons: Loops through EVERY folder until it matches the "SingleFolderRequired" variable which i did set
Modifies EVERY file in the Drafts\Financials directory
Pro: Eventually finds the correct directory (Drafts\Financials)
Note: got this to work by doing "Last MailObject" before Next MailObject, but i know that this is NOT the best way as there has got to be a way to not go in a loop at all

How to send All Draft in outlook by vba
Cons: sends EVERY file in the Drafts
Pro: Starts in the Drafts Folder and does not search/compare every single directory
I think, the following would start in the directory I am looking for
Set myDraftsFolder = myFolders("Mailbox - Your Name").Folders("Drafts").Folders("Financials")

Any assistance on modifications would greatly be appreciated
PS. If this is a duplicate thread,i apologize in advance. I thought I posted this yesterday but cant seem to locate it here in the Excel Form

Thanks' in Advance and have a great day

 

[g_speran]

with No replies, here is what I was able to come up with.
Hope it helps someone in the future

Sub ModifyAndSendDraftEmail()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olDraft As Outlook.MailItem
Dim olAttachment As Outlook.Attachment
Dim foundDraft As Boolean

' Initialize Outlook objects
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")

' Specify the folder path
Set olFolder = olNS.GetDefaultFolder(olFolderDrafts).Folders("Financial")

' Check if the folder exists
If olFolder Is Nothing Then
MsgBox "Financial folder not found.", vbExclamation
Exit Sub
End If

' Get the draft emails in the Financial folder
Set olItems = olFolder.Items

' Loop through the draft emails to find one to modify and send
For Each olDraft In olItems
If olDraft.Class = olMail Then
' Check if the email meets the criteria for modification
If olDraft.Recipients.Count > 0 And olDraft.Attachments.Count = 0 Then
' Modify the email
' Change the To line
olDraft.Recipients.Item(1).Address = "[newemail]@[company].com" ' Change [newemail] to the desired email address
' Add an attachment (replace "path_to_attachment" with the actual path)
' olDraft.Attachments.Add "path_to_attachment"
' Search and replace in the body. Looking for [PM] and replacing with Nancy
If InStr(1, olDraft.Body, "[PM]", vbTextCompare) > 0 Then
olDraft.Body = Replace(olDraft.Body, "[PM]", "Nancy")
End If

' Send the modified email
olDraft.Send

' Set foundDraft flag to true
foundDraft = True
' Exit the loop after modifying and sending one email
Exit For
End If
End If
Next olDraft

' If no draft email was found, display a message
If Not foundDraft Then
MsgBox "No suitable draft email found in the Financial folder.", vbExclamation
End If

' Clean up
Set olApp = Nothing
Set olNS = Nothing
Set olFolder = Nothing
Set olItems = Nothing
Set olDraft = Nothing
Set olAttachment = Nothing
End Sub