Inquiry Regarding Outlook Rules

[PeterC12]

Good day,

I have an issue regarding Outlook rules that I'm struggling with, and I'm curious if you have any tips!

I have a scenario concerning rules in Outlook.

I want outgoing emails that I send with a question to receive a blue label. I've managed to set this up using rules, which works perfectly.

Subsequently, I'd like for the blue label to disappear when I receive a reply to these emails, and for the new email to appear green in my inbox. (The green coloring upon reply in the inbox works fine, but the blue category label remains in my sent items.)

The goal is to have a clear overview in my sent items of which emails I still need to follow up on because I haven't received a response. Manually removing the label is an option, but it's prone to being forgotten.

If there's a rule available for achieving this, it would provide a perfect overview of unanswered emails that still need follow-up.


After adjusting some settings (Regedit) I can find 'Run a script' in my Rules Wizard again so now I can post choose the script for this and select the needs and then it works.

But now I need to choose the script but it doesn't show any. The script I use was made by ChatGPT because I don't know how that works.

But my question, how can I make the correct script/macro in VB so that it shows in my Rules Wizard if I click scripts.

The script I want to use is underneath.


Looking forward to your response! Would be amazing and everybody in my company would be so happy. But I would be the one that's the most happy.



Sub RemoveWaitingForResponseCategoryOnReply(Item As Outlook.MailItem)
Dim objSentFolder As Outlook.Folder
Dim objInbox As Outlook.Folder
Dim objSentItem As Outlook.MailItem
Dim objReceivedItem As Outlook.MailItem

Set objSentFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
Set objInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

' Check if the received email is a reply to a sent email
If Item.Parent = objInbox Then
Set objReceivedItem = Item
' Find the corresponding sent email
For Each objSentItem In objSentFolder.Items
If objSentItem.ConversationID = objReceivedItem.ConversationID Then
' Remove the category "Waiting for response from other party" from the sent email
objSentItem.Categories = Replace(objSentItem.Categories, "Waiting for response from other party", "")
objSentItem.Save
Exit For
End If
Next objSentItem
End If
End Sub

[jdelano]

Are you running Outlook on the desktop or using Outlook Web Access? Are you posting this in the ASP, VBScript forum because you're using the web version?

[PeterC12]

Are you running Outlook on the desktop or using Outlook Web Access? Are you posting this in the ASP, VBScript forum because you're using the web version?

Thanks for your reply! I'm running outlook on the desktop.

[jdelano]

This article explains how to create an event that then executes a macro when email is received. https://www.tachytelic.net/2017/10/h...ed-in-outlook/ you can also enable running a macro via a rule, which has been disabled by default and then point that to a macro to handle the decoloring of the matching sent email. https://www.slipstick.com/outlook/ru...w-using-macro/

EDIT:
I found that the conversation id didn't match between sent email and a reply to it. I used something more generic, if the sender of the reply matches the recipient of the sent email and the subject of the sent email was found in the subject of the received email, the received email is considered a reply to the sent email.

Also, added a bit of code to sort the sent mail folder by ReceivedTime in descending order figuring starting of the newest sent emails will make the check faster.
I was testing using a different account from the default, so I have code to find the account the email was sent from, then get the sent folder for that account.

I'm triggering this code via a rule that launches the script.

here is the code I used:

Public Sub CheckForSentEmailReply(recvdEmail As Outlook.MailItem)
    
    ' with the email sent to this macro
    ' check to see if it is a reply to a sent email
    ' if so, and the sent email is colored, clear the color
    
    ' if the email isn't a reply to a previous email there is no need to check anything
    If recvdEmail.ConversationID = "" Then Exit Sub
    
    Dim sentFolder As Folder
    Dim sentFolderItems As Items
    Dim sentMailItem As MailItem
    
    ' get the account object for the account that sent the email
    Dim emailAccount As Outlook.Account
    For Each emailAccount In ThisOutlookSession.Application.Session.Accounts
        If emailAccount = recvdEmail.ReceivedOnBehalfOfName Then
            Exit For
        End If
    Next
    
    If emailAccount Is Nothing Then
        MsgBox "The account for " & recvdEmail.ReceivedOnBehalfOfName & " wasn't found!", vbCritical, "Search for Account"
        Exit Sub
    End If
    
    ' get the sent email folder for the account that received the email
    Set sentFolder = GetFolderPath(recvdEmail.ReceivedOnBehalfOfName & "\Sent")
    Set sentFolderItems = sentFolder.Items
    
    ' sort the sent folder items by received time in descending order
    sentFolderItems.Sort "[ReceivedTime]", True
    
    ' loop through the sent email folder
    For Each sentMailItem In sentFolderItems
        ' if the email address from the received email matches the recipient of the sent mail
        ' and the subject of the sent mail is in the subject of the received email - then consider this a match
        If sentMailItem.To = recvdEmail.SenderEmailAddress And InStr(recvdEmail.Subject, sentMailItem.Subject) > 0 Then
            sentMailItem.Categories = Replace(sentMailItem.Categories, "Waiting for response from other party", "")
            sentMailItem.Save
            Exit For
        End If
    Next sentMailItem
    
    Set emailAccount = Nothing
    Set sentFolder = Nothing
End Sub

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder

    ' got this code from https://www.slipstick.com/developer/working-VBA-nondefault-outlook-folders/
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer
        
    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function
        
GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

[PeterC12]

Thank you a lot for your detailed answer, I appreciate it a lot!

I get what you're saying, only thing I don't understand i:

- Which part exactly do I need to paste in my VBA - Project 1 - Module?

I'm not experienced with VBA. Started using it 2 days ago and have been reading and searching all day about it.

But could you please explain which part I need to upload in the 'Module' that is linked to 'Run a script' in my rules so I can select it there?

Or is this code you're sending not too link to 'rules'. I would like to hear from you soon. And, thanks a lot in advance!

[jdelano]

Here is some info you can follow https://www.slipstick.com/developer/...ks-vba-editor/

[PeterC12]

Here is some info you can follow https://www.slipstick.com/developer/...ks-vba-editor/

Thanks! I read everything and watched some video's. Only question: Which part of the 2 codes you've sent me do I need to paste in the Module?

Because it's not working right now. I hope you can give me the exact text I need to paste in VB Module. Would be amazing. Thanks a lot in advance.

Because, are the codes you've sent me meant to be put in Module and then selected via Rules - run a script?
Or meant to be used via the way the website describes with the link you've sent me?

[jdelano]

Have you setup a rule to launch the macro when an email is received?

[PeterC12]

Have you setup a rule to launch the macro when an email is received?

Yes. Via Rules and Alerts -> ''Apply this rule once the message the message has arrived - only on this computer - run Project.1RemoveWaitingForResponseCategoryOnReply.

See pictures below.

[jdelano]

hmmm, I don't see the actual procedure in your photo, is the line above the commented out line CheckForSentEmailReply?

[PeterC12]

hmmm, I don't see the actual procedure in your photo, is the line above the commented out line CheckForSentEmailReply?

These 2 screenshots are the information in my Module 1, VBA-project. But you're saying the information in the module is not correct?

Thanks.

[jdelano]

Correct, Module1 doesn't have a sub procedure because the line

Sub CheckForSentEmailReply(recvdEmail as Outlook.MailItem)

is commented out. Unless there is another line above that that has been scrolled out of view.

[PeterC12]

Sorry for late reply, didn't get a notification this time haha.

No there is no line above that. Underneath is exactly what's pasted in the module:

'Public Sub CheckForSentEmailReply(recvdEmail As Outlook.MailItem)

' with the email sent to this macro
' check to see if it is a reply to a sent email
' if so, and the sent email is colored, clear the color

' if the email isn't a reply to a previous email there is no need to check anything
If recvdEmail.ConversationID = "" Then Exit Sub

Dim sentFolder As Folder
Dim sentFolderItems As Items
Dim sentMailItem As MailItem

' get the account object for the account that sent the email
Dim emailAccount As Outlook.Account
For Each emailAccount In ThisOutlookSession.Application.Session.Accounts
If emailAccount = recvdEmail.ReceivedOnBehalfOfName Then
Exit For
End If
Next

If emailAccount Is Nothing Then
MsgBox "The account for " & recvdEmail.ReceivedOnBehalfOfName & " wasn't found!", vbCritical, "Search for Account"
Exit Sub
End If

' get the sent email folder for the account that received the email
Set sentFolder = GetFolderPath(recvdEmail.ReceivedOnBehalfOfName & "\Sent")
Set sentFolderItems = sentFolder.Items

' sort the sent folder items by received time in descending order
sentFolderItems.Sort "[ReceivedTime]", True

' loop through the sent email folder
For Each sentMailItem In sentFolderItems
' if the email address from the received email matches the recipient of the sent mail
' and the subject of the sent mail is in the subject of the received email - then consider this a match
If sentMailItem.To = recvdEmail.SenderEmailAddress And InStr(recvdEmail.Subject, sentMailItem.Subject) > 0 Then
sentMailItem.Categories = Replace(sentMailItem.Categories, "Waiting for response from other party", "")
sentMailItem.Save
Exit For
End If
Next sentMailItem

Set emailAccount = Nothing
Set sentFolder = Nothing
End Sub

[jdelano]

I see, then that code is broken and won't run though you have your own macro name selected in the rules area. Where is the macro 1RemoveWaitingForResponseCategoryOnReply? Is that in a Module? I do not see that displayed in your screenshot.

[PeterC12]

I see, then that code is broken and won't run though you have your own macro name selected in the rules area. Where is the macro 1RemoveWaitingForResponseCategoryOnReply? Is that in a Module? I do not see that displayed in your screenshot.

Thanks for your reply. Do I need to set up 2 macro's for this one task? I only have 1 now.

[PeterC12]

Thanks for your reply. Do I need to set up 2 macro's for this one task? I only have 1 now.

@jdelano have you seen my message? best regards,

[jdelano]

Hey there, sorry. No, one Rule to call the macro from Module 1. In the morning, I will upload screenshots of the exact setup I have in Outlook I did to test this.

[PeterC12]

Hey there, sorry. No, one Rule to call the macro from Module 1. In the morning, I will upload screenshots of the exact setup I have in Outlook I did to test this.

Perfect thanks! Could you please copy, paste the exact code you've used as well? Then I can just paste that text in my module. Then connect it to run a script for incoming mail and we should be set.

Thanks a lot in advance!

[jdelano]

The code I posted is the exact code I used; they are both put in the Outlook Session module (as per the article I posted the link for previously). Then as I said, you create a rule on the account that you will receive the replies. Here are screenshots from my test, the articles posted gave the instructions you need to do this as well.