Auto Filing of Emails | Outlook

Hi all,

I use Outlook (2016); for the work I do (Immigration Support) I deal with several cases at once so a lot of my emails have a case number which is listed in the subject line. My inbox might look like this for example

Email 1 | Subject: Documents Needed | Steve [#2598]
Email 2 | Subject: Application has been approved | Emma [#2489]
Email 3 | Subject: General Question Immigration

For a lot of my emails I have a file number in the format above but in some cases no file is made (yet) so then it's blank. When I send emails with a file number the email is automatically saved in our system. However I also save my emails (including sent emails) in a folder in Outlook (rather have it in 2 places for easy access)

Let's say I answer email 1 as mentioned above, instead of going to the folder and filing first the email in my inbox and then file the email in sent items I move the email from the inbox (which I just answered) to my sent items... then procrastinate filing them until my sent items folder fills up and then I move all emails regarding Steve [#2598] to the correct folder in one go.
When I create a folder in outlook I name it using the following format [NAME (number)] example: Steve (2598)

My question, is there a way to have outlook run a task or rule (or Macro perhaps) which does the following:
1) 'scans' all email in my sent items
2) registers that there are (for example) 20 out of 30 emails that have a file number in the following format [#number]
3) then recognizes that the file number in the subject line corresponds with a number in the folder name
4) Outlook then automatically moves all emails with a file number from sent items to the correct corresponding folder
5) emails that don't have a number stay where they are and I'll just file those manually.

I know Outlook has Rules & Alerts that can be set but those seems to mainly work for new items coming in. Also, as far as I know I would then have to create a new rule for every single file number.

If anyone happens to have a solution (external program might also be an option) that would awesome :-)

Thank you and if unclear I will gladly clarify.

This is relatively straightforward with a macro to process the items in your sent items folder. The only issue unclear is where you have created the folders containing the names and numbers.
The following assumes that these folders are sub-folders of the same root folder that Sent Items is located in. If they are somewhere else then you will need to change the location where indicated.

Code:

---

Sub FileSent()
'Graham Mayor - http://www.gmayor.com - Last updated - 22 Jul 2017
Dim oFolder As Folder
Dim oParent As Folder
Dim oSubFolder As Folder
Dim oItem As Object
Dim vSubject As Variant
Dim sFolder As String
Dim bFound As Boolean
    Set oFolder = Session.GetDefaultFolder(olFolderSentMail)
    'set the following line to the location where your named folders are stored
    Set oParent = Session.GetDefaultFolder(olFolderSentMail).Parent
    For Each oItem In oFolder.Items
        bFound = False
        If InStr(1, oItem.Subject, "|") > 0 Then
            If InStr(1, oItem.Subject, "[#") > 0 Then
                vSubject = Split(oItem.Subject, "|")
                sFolder = Replace(vSubject(1), "[#", "(")
                sFolder = Replace(Trim(sFolder), "]", ")")
                For Each oSubFolder In oParent.folders
                    If oSubFolder.Name = sFolder Then
                        oItem.Move oSubFolder
                        bFound = True
                        Exit For
                    End If
                Next oSubFolder
                If Not bFound Then
                    Set oSubFolder = oParent.folders.Add(sFolder)
                    oItem.Move oSubFolder
                End If
            End If
        End If
        DoEvents
    Next oItem
lbl_Exit:
    Set oFolder = Nothing
    Set oParent = Nothing
    Set oSubFolder = Nothing
    Set oItem = Nothing
    Exit Sub
End Sub

---

This is great thank you so much

The folders are all set up under 'Inbox' and 'Sent' is a separate folder next to inbox.
Attachment 19848

If I understand correctly the line "Set oParent = Session.GetDefaultFolder(olFolderSentMail).Parent" would need to become "Set oParent = Session.GetDefaultFolder(olFolderInbox).Parent"

No it would simply be

Code:

---

Set oParent = Session.GetDefaultFolder(olFolderInbox)

---

Session.GetDefaultFolder(olFolderInbox).Parent is usually the same location as Session.GetDefaultFolder(olFolderSentMail).Parent

I added it as follows but it doesn't seem to work. I tried changing the text from SentMail to Sent to see if that might help because the folder is named Sent but it gave me an error code when I did that. "Run-time error '-2147024809 (80070057)"

Code:

---

Sub FileSent()

    Dim oFolder As Folder
    Dim oParent As Folder
    Dim oSubFolder As Folder
    Dim oItem As Object
    Dim vSubject As Variant
    Dim sFolder As String
    Dim bFound As Boolean
    Set oFolder = Session.GetDefaultFolder(olFolderSentMail)
    Set oParent = Session.GetDefaultFolder(olFolderInbox)
    For Each oItem In oFolder.Items
        bFound = False
        If InStr(1, oItem.Subject, "|") > 0 Then
            If InStr(1, oItem.Subject, "[#") > 0 Then
                vSubject = Split(oItem.Subject, "|")
                sFolder = Replace(vSubject(1), "[#", "(")
                sFolder = Replace(Trim(sFolder), "]", ")")
                For Each oSubFolder In oParent.Folders
                    If oSubFolder.Name = sFolder Then
                        oItem.Move oSubFolder
                        bFound = True
                        Exit For
                    End If
                Next oSubFolder
                If Not bFound Then
                    Set oSubFolder = oParent.Folders.Add(sFolder)
                    oItem.Move oSubFolder
                End If
            End If
        End If
        DoEvents
    Next oItem
lbl_Exit:
    Set oFolder = Nothing
    Set oParent = Nothing
    Set oSubFolder = Nothing
    Set oItem = Nothing
    Exit Sub
End Sub

---

edit: I had to take the link out otherwise it wouldn't let me post the message

You can't change the inbuilt folder names. When you say it doesn't work, what does happen. Do you get error messages?
Because removing messages from a list affects the count, I have modified the macro as shown below to process the list in reverse order. The revised version certainly works here with subjects lifted from your original message to create the named folders.

Some account servers do not allow the creation of folders by VBA so that could prove a problem.

Code:

---

Sub FileSent()

Dim oFolder As Folder
Dim oParent As Folder
Dim oSubFolder As Folder
Dim oItem As Object
Dim vSubject As Variant
Dim sFolder As String
Dim bFound As Boolean
Dim lngCount As Long
    Set oFolder = Session.GetDefaultFolder(olFolderSentMail)
    Set oParent = Session.GetDefaultFolder(olFolderInbox)
    For lngCount = oFolder.Items.Count To 1 Step -1
        bFound = False
        Set oItem = oFolder.Items(lngCount)
        If InStr(1, oItem.Subject, "|") > 0 Then
            If InStr(1, oItem.Subject, "[#") > 0 Then
                vSubject = Split(oItem.Subject, "|")
                sFolder = Replace(vSubject(1), "[#", "(")
                sFolder = Replace(Trim(sFolder), "]", ")")
                For Each oSubFolder In oParent.folders
                    If oSubFolder.Name = sFolder Then
                        oItem.Move oSubFolder
                        bFound = True
                        Exit For
                    End If
                Next oSubFolder
                If Not bFound Then
                    Set oSubFolder = oParent.folders.Add(sFolder)
                    oItem.Move oSubFolder
                End If
            End If
        End If
        DoEvents
    Next lngCount
lbl_Exit:
    Set oFolder = Nothing
    Set oParent = Nothing
    Set oSubFolder = Nothing
    Set oItem = Nothing
    Exit Sub
End Sub

---

It doesn't seem to do anything when I activate the Macro, it's not giving me an error message but it also isn't moving the email. I have a lot of folders in my account (IMAP if that's important) but in order to test the Macro I did the following:

Inbox
- 0. TEST (0001)
- 'all other folders'
Sent

1) I sent myself an email with the subject TEST [#0001]
2) Created a folder under inbox named 0. TEST (0001) - I added the 0. so it would appear on top for easy testing. Also tried it without the 0 at the beginning but that didn't work either
3) Located the sent email in my Sent folder (it's the only folder in there at the moment)
4) Went to devloper/visualbasic and added the text as above
5) Ran the Macro while in the Sent folder but the email stayed where it was and did not appear in the previously created folder.

Note: just to clarify I'm looking for Outlook to move message from the Sent folder to the corresponding folder, no need for Outlook to create a folder if it doesn't exist (would actually prefer if it didn't create a folder)

Hope this helps, if screenshots or something else would be good to have please let me know.

Note: I added the Macro as a Module (I also have another Macro there allowing me to easily locate folders but they are both added as separate modules)

The code is designed to work with a subject in the format you indicated i.e.
Documents Needed | Steve [#2598]
Application has been approved | Emma [#2489]

I am using that format [#0001] or does it also need to include the | symbol?

If that's the case I only need it to recognize the following within quotes "[#0001]" all the other information is irrelevant

The code uses the pipe character in your examples as a start point to determine whether the e-mail is a valid subject for the filing process. Trying to extract random names and and numbers from a text string (the subject) is not at all straightforward, which is why I asked you to supply examples. The code is based on those examples.

You also said that the folders are named similar to Steve (2598), so you need to be able to grab the name as well as the number in order to be able to establish which folder it goes in. The code I posted does that when the subject matches the pattern you indicated.

If you only have [#0001] and you have (only one) sub folder with 0001 in its name, then the following macro should move the message to that folder - again it does so here. This requires an additional function to determine whether the subject contains the bracketed number sequence, and if so strips it to give just the number e.g. 0001. The original macro has been abbreviated to only look for an existing first level sub folder of inbox that includes that number.

This was way beyond the level of help that this forum provides and marks the end of the time I can spend on this topic. You can show your appreciation at my web site .

Code:

---

Option Explicit

Private Type GetNum
    sSubject As String
    bFound As Boolean
End Type

Sub FileSent()

Dim oFolder As Folder
Dim oParent As Folder
Dim oSubFolder As Folder
Dim oItem As Object
Dim strSubject As String
Dim lngCount As Long
    Set oFolder = Session.GetDefaultFolder(olFolderSentMail)
    Set oParent = Session.GetDefaultFolder(olFolderInbox)
    For lngCount = oFolder.Items.Count To 1 Step -1
        Set oItem = oFolder.Items(lngCount)
        strSubject = oItem.Subject
        If IsNumbered(strSubject).bFound = True Then
            For Each oSubFolder In oParent.folders
                If oSubFolder.Name Like "*" & IsNumbered(strSubject).sSubject & "*" Then
'Debug.Print oSubFolder.Name
                    oItem.Move oSubFolder
                    Exit For
                End If
            Next oSubFolder
        End If
        DoEvents
    Next lngCount
lbl_Exit:
    Set oFolder = Nothing
    Set oParent = Nothing
    Set oSubFolder = Nothing
    Set oItem = Nothing
    Exit Sub
End Sub

Private Function IsNumbered(strSubject As String) As GetNum
Dim lngStart As Long: lngStart = 0
Dim lngEnd As Long: lngEnd = 0
Dim vSets As GetNum
    If InStr(1, strSubject, "[#") > 0 Then
        lngStart = InStr(1, strSubject, "[#")
    End If
    If lngStart > 0 Then
        If InStr(lngStart, strSubject, "]") > 0 Then
            lngEnd = InStr(lngStart, strSubject, "]")
        End If
    End If
    If lngStart > 0 And lngEnd > lngStart Then
        strSubject = Mid(strSubject, lngStart + 2, (lngEnd - lngStart) - 2)
        If IsNumeric(strSubject) = True Then
            With vSets
                .sSubject = strSubject
                .bFound = True
            End With
        Else
            With vSets
                .sSubject = strSubject
                .bFound = False
            End With
        End If
    Else
        With vSets
            .sSubject = strSubject
            .bFound = False
        End With
    End If
lbl_Exit:
    IsNumbered = vSets
    Exit Function
End Function

---