#1
|
|||
|
|||
Looking for advice
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! |
#2
|
||||
|
||||
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: Code:
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
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 |
#4
|
|||
|
|||
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.
|
#5
|
|||
|
|||
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.
|
#6
|
||||
|
||||
Quote:
See http://www.gmayor.com/installing_macro.htm The illustrations are from Word, but Outlook's VBA editor is identical.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Looking for advice on pivot tables | Guloluseus | Excel | 2 | 10-23-2015 04:11 AM |
Advice on Type of Format to Use | srobert32 | Word | 2 | 07-03-2012 05:07 AM |
Advice Needed on Possible VBA usage | HorizonSC | Excel Programming | 2 | 09-21-2011 02:47 AM |
Advice on my Excel Project | woodland81 | Excel | 4 | 12-28-2010 01:09 PM |
PST Advice | Panzer | Outlook | 1 | 06-28-2010 06:29 PM |