Looking for advice

[J-OSR]

Hello,



Hopefully someone can help point me in the right direction.

I work with a company of about 50 or so office employees who are handling multiple construction projects. The issue we are having is that with our workload and fast paced environment, important emails do not always get filed or allocated to the specific job they pertain to.

For example, we will get an email with authorization to proceed with additional work at an additional cost. We do the work, time goes by, we send the bill and the client then has no recollection or history of this "authorization" and denies the payment to us, or at least argues it.

On our end, the email may have been deleted, lost or misfiled.

My objective is to somehow auto-file / tag these emails that pertain to certain jobs and have them automatically filed into a folder for that specific job.

We are all using Microsoft Outlook connected to Microsoft Exchange. Hopefully there is an easy solution, right now we are just relying on everyone doing their job and filing the emails in the corresponding folder on their account.

Thanks in advance!

[gmayor]

Ultimately it boils down to staff ensuring the necessary flags are available. One possibility is to use a macro to save a dated copy of the current message into a hard drive folder that reflects the client name and the job number.


The following will do that. It prompts for a name and a job number and includes code to create folders, remove illegal filename characters and avoid overwriting similarly named files. The process still requires the user to run the macro, and in a real world situation it could be tidied up to read clients from a data file into a userform to cut down on pilot error, but it will save your messages:

Option Explicit

Sub SaveClientMessage()
'Graham Mayor - http://www.gmayor.com - Last updated - 12 Jul 2018
Const strPath As String = "C:\Path\"    ' the root folder in which to save the messages
Dim strJobNum As String
Dim strClient As String
Dim strSavePath As String
Dim olMsg As MailItem

    strClient = InputBox("Enter Client Name")
    If strClient = "" Then
        Beep
        MsgBox "No client entered - start again!"
        GoTo lbl_Exit
    End If
    strClient = CleanFileName(strClient)
    strJobNum = InputBox("Enter Job Number")
    If strJobNum = "" Then
        Beep
        MsgBox "No job number entered - start again!"
        GoTo lbl_Exit
    End If
    strJobNum = CleanFileName(strJobNum)
    strSavePath = strPath & strClient & "\" & strJobNum & "\"
    CreateFolders strSavePath
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    SaveMessage olMsg, strSavePath
lbl_Exit:
    Set olMsg = Nothing
    Exit Sub
End Sub

Private Sub SaveMessage(olItem As MailItem, sPath As String)
'An Outlook macro by Graham Mayor - www.gmayor.com
Dim fname As String

    fname = Format(olItem.ReceivedTime, "yyyymmdd") & Chr(32) & _
            Format(olItem.ReceivedTime, "HH.MM") & " - " & olItem.SenderName & " - " & olItem.Subject
    fname = Replace(fname, Chr(58) & Chr(41), "")
    fname = Replace(fname, Chr(58) & Chr(40), "")
    fname = Replace(fname, Chr(34), "-")
    fname = Replace(fname, Chr(42), "-")
    fname = Replace(fname, Chr(47), "-")
    fname = Replace(fname, Chr(58), "-")
    fname = Replace(fname, Chr(60), "-")
    fname = Replace(fname, Chr(62), "-")
    fname = Replace(fname, Chr(63), "-")
    fname = Replace(fname, Chr(124), "-")
    SaveUnique olItem, sPath, fname
lbl_Exit:
    Exit Sub
End Sub

Private Function SaveUnique(oItem As Object, _
                            strPath As String, _
                            strfilename As String)
'An Outlook macro by Graham Mayor - www.gmayor.com
Dim lngF As Long
Dim lngName As Long
Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    lngF = 1
    lngName = Len(strfilename)
    Do While oFSO.FileExists(strPath & strfilename & ".msg") = True
        strfilename = Left(strfilename, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    oItem.SaveAs strPath & strfilename & ".msg"
lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function

Private Function CreateFolders(strPath As String)
'An Office macro by Graham Mayor - www.gmayor.com
Dim strTempPath As String
Dim lngPath As Long
Dim vPath As Variant
Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    vPath = Split(strPath, "\")
    strPath = vPath(0) & "\"
    For lngPath = 1 To UBound(vPath)
        strPath = strPath & vPath(lngPath) & "\"
        If Not oFSO.FolderExists(strPath) Then MkDir strPath
    Next lngPath
lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function

Private Function CleanFileName(strfilename As String) As String
'Graham Mayor
'A function to ensure there are no illegal filename
'characters in a string to be used as a filename
Dim arrInvalid() As String
Dim lngIndex As Long

    CleanFileName = strfilename
    'Define illegal characters (by ASCII CharNum)
    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
    'Remove any illegal filename characters
    For lngIndex = 0 To UBound(arrInvalid)
        CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lngIndex)), Chr(95))
    Next lngIndex
lbl_Exit:
    Exit Function
End Function

[J-OSR]

Thanks for the reply.

Im not a programmer, I'm sure I could attempt to implement that but I'm looking for a more user friendly solution. Perhaps a 3rd party add-on?

Thanks

[gmayor]

Originally Posted by J-OSR

Thanks for the reply.

Im not a programmer, I'm sure I could attempt to implement that but I'm looking for a more user friendly solution. Perhaps a 3rd party add-on?

Thanks

You don't need to be a programmer as I have done the programming for you. All you have to do is copy and paste and add a button to the ribbon, using Outlook's ribbon editor to run the macro 'SaveClientMessage'


See http://www.gmayor.com/installing_macro.htm The illustrations are from Word, but Outlook's VBA editor is identical.

[msperry]

It sounds like all you need to do is implement an Outlook rule to copy the message to an archive folder, preferably one where the users do not have permission to delete or modify.

[J-OSR]

Originally Posted by msperry

It sounds like all you need to do is implement an Outlook rule to copy the message to an archive folder, preferably one where the users do not have permission to delete or modify.

Thank you. That sounds great and I will explore that option. Ideally, I would like to be able to have somewhat of an automation to archive those emails to their corresponding projects.