Consulting

Results 1 to 10 of 10

Thread: Auto Filing of Emails | Outlook

  1. #1
    VBAX Newbie
    Joined
    Jul 2017
    Posts
    5
    Location

    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.

  2. #2
    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.


    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Newbie
    Joined
    Jul 2017
    Posts
    5
    Location
    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"

  4. #4
    No it would simply be
    Set oParent = Session.GetDefaultFolder(olFolderInbox)
    Session.GetDefaultFolder(olFolderInbox).Parent is usually the same location as Session.GetDefaultFolder(olFolderSentMail).Parent
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Newbie
    Joined
    Jul 2017
    Posts
    5
    Location
    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)"

    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

  6. #6
    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.

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Newbie
    Joined
    Jul 2017
    Posts
    5
    Location
    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)

  8. #8
    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]

    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    VBAX Newbie
    Joined
    Jul 2017
    Posts
    5
    Location
    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

  10. #10
    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 .

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •