' LOOK FOR OUTLOOK OPEN Dim objOL As OUTLOOK.Application ' search inbox for this id Dim myOlApp As New OUTLOOK.Application Dim myNameSpace As OUTLOOK.Namespace Dim myInbox As OUTLOOK.MAPIFolder Dim myitems As OUTLOOK.Items Dim myitem As Object Dim Found As Boolean Dim objInsp As OUTLOOK.Inspector Dim objActionsMenu As Office.CommandBarControl Dim olResendMsg As OUTLOOK.MailItem Dim ProfileN As String ' to find the right store or profile name Dim colStores As OUTLOOK.Stores Dim oStore As OUTLOOK.Store Dim oRoot As OUTLOOK.Folder ' folder Dim folders As OUTLOOK.folders Dim Folder As OUTLOOK.Folder Dim foldercount As Integer Dim oFolder As OUTLOOK.Folder Set colStores = OUTLOOK.Application.Session.Stores For Each oStore In colStores y = oStore.DisplayName If y = "email@example.com" Or y = "bookprice" Then Set oRoot = oStore.GetDefaultFolder(olFolderInbox) Set folders = oRoot.folders foldercount = folders.Count 'Check if there are any folders below oFolder Set myInbox = oRoot Set myitems = oRoot.Items ' ok we have records. generate records t = "Action Required - Pricing Escalation #4196" ' search inbox for ID Found = False For Each myitem In myitems y = myitems.Count If InStr(1, myitem.Subject, "" & t & "") > 0 Then 'MsgBox "Found" ' Debug.Print "Found" Found = True ' run the resend command Set objInsp = myitem.GetInspector objInsp.CommandBars.ExecuteMso ("ResendThisMessage") ' get the opened compose message form & send it Set olResendMsg = myitem ' update fields if needed olResendMsg.CC = "firstname.lastname@example.org" olResendMsg.BCC = "email@example.com" olResendMsg.Subject = "REMINDER: 2nd Request Please Respond : " & t & "" olResendMsg.Send Else ' do nothing End If Next myitem 'If the subject isn't found: If Not Found Then ' NoResults.Show MsgBox "Pricing " & t & " Could Not Be Found. You will need to review Manually and send Notice." End If If Found = True Then MsgBox "2ND Reminder Messages Sent !", vbOKOnly, "2nd Reminder Notice eMails" End If ' this end if is for making sure we have the right profile name "Store" bookprice End If Next Set myNameSpace = Nothing Set myInbox = Nothing Set myitems = Nothing Set myOlApp = Nothing
Gain unlimited access to on-demand training courses with an Experts Exchange subscription.Get Access
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE
Connect with Certified Experts to gain insight and support on specific technology challenges including: