Consulting

Results 1 to 4 of 4

Thread: Outlook 365 VBA Script to move mails with ticket number in subject

  1. #1

    Outlook 365 VBA Script to move mails with ticket number in subject

    Hi there.
    To start of I have limited VBA knowledge in Excel and this is my first run at trying VBA in Outlook.
    Our company makes use of tickets related to issues orders requests ect, and this mails is filling up an inbors very quickly.
    I am looking for a way to move mails which contains a ticket number (For example: ABC- in the subject line to a sub folder (With the same name as the ticket number) in the inbox.
    Ideally A function that does this will be great then I can only send a list of values (That will expand over time) to the function and the function will sort out the move of various mails.

    Any help or advice will be greatly appreciated.

  2. #2
    In order to do this it is necessary to identify exactly how the subjects containing the ticket numbers are formatted so as to be able to differentiate them from other e-mails that might have numbers in the subject that are not ticket numbers. As for the sub folders, if this also relates to the subject then how is the folder data to be identified? Do the folders exist or are they to be created (some e-mail servers do not allow the creation of sub folders from VBA when access is not via POP). As for the folders themselves are these Outlook folders or Windows folders.

    There are too many unknowns to suggest a way forward. You could start by posting some actual subjects.
    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
    The ticket number will be three characters (ABC) with a "-" followed by a running number sequence. For example ABC-892576. My Idea is send specific ticket numbers to a function, and then the mail containing that specific ticket number in subject line will need to be move to the same named folder (ABC-892576). I will manually create each folder before I add the ticket number to the list of values that I want to send to the function.

  4. #4
    As I anticipated, establishing whether the particular ticket number sequence exists in the subjects of a batch of e-mails that may or may not have such a sequence, and then extracting that ticket number was always going to be problematical. But for the hot and humid weather which has kept me at my desk, instead of doing something more useful, I would probably have given up.

    However the following seems to work, and while I have not exhausted every conceivable e-mail subject construction, I have run it on my inbox of many items and it picks out only those that have letters and numbers in the format requested. The process also creates the folders if not present.

    The macro looks for subjects that include values like ABC-892576 and not (ABC-892576) nor ABC - 892576
    It puts the matching e-mails in a sub folder of Inbox named like ABC-892576 and not (ABC-892576)
    If you want the brackets I'll let you edit them in.


    Option Explicit
    'Graham Mayor - http://www.gmayor.com - Last updated - 24 Jul 2017
    Private Type TicketSettings
        Ticket As String
        Found As Boolean
    End Type
    
    Sub MoveTickets()
    'Graham Mayor - http://www.gmayor.com - Last updated - 24 Jul 2017
    Dim oFolder 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
    Dim oSettings As TicketSettings
    
        Set oFolder = Session.GetDefaultFolder(olFolderInbox)
        For lngCount = oFolder.Items.Count To 1 Step -1
            Set oItem = oFolder.Items(lngCount)
            oSettings = TicketItem(oItem)
            bFound = False
            If oSettings.Found = True Then
                sFolder = Trim(oSettings.Ticket)
                For Each oSubFolder In oFolder.folders
                    If oSubFolder.Name = sFolder Then
                        bFound = True
                        Exit For
                    End If
                Next oSubFolder
                If Not bFound = True Then
                    Set oSubFolder = oFolder.folders.Add(sFolder)
                End If
                oItem.Move oSubFolder
            End If
            DoEvents
        Next lngCount
    lbl_Exit:
        Set oFolder = Nothing
        Set oSubFolder = Nothing
        Set oItem = Nothing
        Exit Sub
    End Sub
    
    Private Function TicketItem(olItem As Object) As TicketSettings
    'Graham Mayor - http://www.gmayor.com - Last updated - 24 Jul 2017
    Dim strText As String
    Dim i As Integer, j As Integer, iLen As Integer
    Dim vSets As TicketSettings
    
        On Error Resume Next
        strText = olItem.Subject
        i = InStr(1, strText, "-")
        If i > 4 Then
            strText = Right(strText, Len(strText) - (i - 4))
        End If
        iLen = Len(strText)
        For j = 5 To iLen
            If Not IsNumeric(Mid(strText, j, 1)) = True Then
                Exit For
            End If
        Next j
        strText = Trim(Left(strText, j))
        If InStr(1, strText, "-") > 0 And _
           j > 5 And _
           Mid(strText, 1, 1) = UCase(Mid(strText, 1, 1)) And _
           IsNumeric(Mid(strText, 1, 1)) = False And _
           Mid(strText, 2, 1) = UCase(Mid(strText, 2, 1)) And _
           IsNumeric(Mid(strText, 2, 1)) = False And _
           Mid(strText, 3, 1) = UCase(Mid(strText, 3, 1)) And _
           IsNumeric(Mid(strText, 3, 1)) = False Then
            With vSets
                .Ticket = strText
                .Found = True
            End With
        Else
            With vSets
                .Ticket = ""
                .Found = False
            End With
        End If
    lbl_Exit:
        TicketItem = 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

Tags for this Thread

Posting Permissions

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