Email Management 2

[teaaddict]

When managing a project we send and receive a large number of Emails using MS outlook. These we drag and drop into a common folder on our network for reference.

However we give the Email a sequential number for out going and another for incoming mails. So when sending a mail the sequence of open up a number index on word, copy the header with number, send the mail. Go to the send items box and drag and drop into the appropriate folder then delete the outbox version so this does not get copied a gain.

How do other people mange project Emails and is there a better way

 

[MikeHalloran]

We use a structured folder tree per project, managed by a single person, who adds Outlook messages by drag and drop, and then renames the envelopes to something he thinks is descriptive. The structure of the envelope names is not real consistent, especially when he is rushed, which is always.

To retrieve a message, you have to imagine what he would have called it, or where he thought it should go in the folder tree, or search for it, based on what you conjecture is in the message body. Good luck with that.

There HAS TO BE a better way. I'm hoping someone will chime in with it.


Mike Halloran
Pembroke Pines, FL, USA

 

[corus]

I just print the them off. No need to search directories for them or to worry about discs crashing and losing all the data. I can find them very easily in the hard copy file in the cupboard, and can even make notes on them or doodle on the other side of the paper when bored. Try doing that with an electronic email. I've also found that it's very difficult to delete them when they're written on a piece of paper unless I physically tear them up and throw them into the bin. With emails, just a nervous tic can send stuff to the trash can.... and gone forever in cyber space.

corus

 

[CorBlimeyLimey]

You could set up a company email server which distributes and records all transactions. (Exchange Server or similar)

Or set up shared accounts. (Google sharing email)


A 'simple' manual method would be:
Setup a PST file for each project on each users outlook account. Give the PST file the project name and or number, and the users name. (e.g. Test-123-CBL.pst)
Have each user be responsible for storing pertinent emails (received and sent) into this folder (or set up rules to re-direct automatically).
The pst files could then be copied to a central access point for others to read. (read only)

These should eliminate the need for drag and dropping, and renaming, and complete conversations would be available as per normal.

 

[teaaddict]

Thanks for the replies.

I am also interested in the auto numbering of Emails. Since the QA highlighted that if you lose a mail either electronic or paper how do you know that it existed in the first place. If it had a number then there would be a number missing.

I am thinking of programming the step but I hope that there is a better way.

 

[MikeHalloran]

All of our email in both directions goes through a service in a remote city, where copies are stored for some time. Our IT guys don't tell you about it unless you ask, but yes, there is a backup, and you can search for and retrieve, but not erase, anything that's gone through the pipe in the past year or so.





Mike Halloran
Pembroke Pines, FL, USA

 

[fel3]

Take a look at MsgSave.com

So far I have only used the trial version, but am seriously contemplating buying standard version.

Fred

 

[SteveGregory]

CorBlimey,
I am interested in the PST file approach. How do you setup these files? Are they viewable from Outlook without having to move or copy anything?

 

[CFSEng]

I wrote an Outlook macro that is installed on everyone's machine. When you have an email that is project related (either in the inbox or sent items folder, you select the email and run the macro. It opens a prompt box asking for the project number then saves a copy of the email in the project folder "job no/corres/in" or "job no/corres/out" The email name is the subject with the date in YYMMDD_HHMMSS appended on front to make sure there are no duplicate names. This way, as long as everyone is "archiving" the emails, you can go to the projects corres folder and see all the emails in order of date sent or received. Nothing fancy but easy for the employees to use and easy to track down emails. Since they are saved as emails, you can also open the email from the project folder and forward or respond to it if needed.

 

[WMO]

CFSEng,
Care to share your code?

 

[teaaddict]

I have started writing a similar macro but this is a job done in my “spare time” i.e. is not getting done.

I want to add and sequentially number the mails as well and check for duplicates in order to suffix them with another character.

The other part I intend to develop is to save the attachments in a folder with the same name as the email.

CSFEng
Any chance of sharing your code (said with hands clasped together in a begging / praying body language stance and puppy dog eyes)

 

[CFSEng]

Sure I'll share the code. Let me add some comments to help explain what it's doing and I'll post it later today (need to get a bid done first). Keep in mind that it is written to work with our database / system of saving projects, but you should be able to pick and choose parts you like.

 

[CFSEng]

Here is the code. Post back if you have any questions...

Option Explicit
'---------
'version 6.0.1
'---------
Dim JobNo As String, where As String
Dim DTName As String, IndexName As String
Dim JobFolder As String, IsFolder As String
Dim email As MailItem
Dim journal As JournalItem
Dim fso As Object
Dim Info As String

Sub SaveMsg()
'***************************************************
'save emails or faxes (attached to email) that are sent or recieved
'possibly add journal entries to track phone calls in future.
'***************************************************

  Dim myOlApp As Outlook.Application
  Dim mySelection As Selection
  Dim i As Integer
  Dim HaveNumber() As String
  Dim temp As Variant
  Dim FaxInfo(1) As String
  Dim myFile As Attachment
  Dim Faxname As String
  Dim EmailName As String
  Dim CleanName As String
  
  'On Error Resume Next
  IsFolder = ""
  Set myOlApp = Application
  Set mySelection = myOlApp.ActiveExplorer.Selection
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  'check email subject for our 8 digit job number
  HaveNumber = Split(mySelection.Item(1).Subject, " ")
  For Each temp In HaveNumber
    If temp Like "########" Or temp Like "########-*" And Left(temp, 1) = 0 Then 'need to fix in 2010
      JobNo = temp
      Info = Join(Filter(HaveNumber, JobNo, False))
      Exit For
    Else
      JobNo = ""
    End If
  Next temp
  
  'call routine to prompt for number (or use one from subject)
  sCheckJobNumber
  
  'verify job folder to save email exists on server
  If IsFolder Like "NoFolder" Then
    MsgBox "Cannot Find Folders: " & Chr(13) & _
            "R:\Product\" & JobNo & "\Corres\" & Chr(13) & _
            "R:\Bid\" & JobNo & "\Corres\"
    Exit Sub
    ElseIf IsFolder Like "Cancel" Then Exit Sub
  End If
  
  'prompt to verify job name is correct based on job number entered (double check for typo)
  fCheckJobName
  If IsFolder Like "Cancel" Then Exit Sub
  
  'step through all selected entities and save them - must verify if email or fax
  For i = mySelection.count To 1 Step -1
    If mySelection.Item(i).Class = olMail Then
      Set email = mySelection.Item(i)
      Info = Trim(email.Subject)
      If Info = "" Then Info = "not_fax"
      'check to see if email contains a fax
      If LCase(Split(Info, " ")(0)) = "fax" And email.Attachments.count > 0 Then 'this is a fax
        Info = Right(Info, Len(Info) - 4)
        temp = Split(Info, ":")
        FaxInfo(0) = Trim(temp(0))
        If UBound(temp) > 0 Then
          FaxInfo(1) = Trim(temp(1))
        Else
          FaxInfo(1) = ""
        End If
        JobFolder = where & "In\"
        Set myFile = email.Attachments(1)
        'to get file info, must save first, get info, then rename file (use move)
        myFile.SaveAsFile (JobFolder & myFile.FileName)
        DTName = Format(FileDateTime(JobFolder & myFile.FileName), "yymmdd_hhmmss")
        If FaxInfo(0) <> "" And FaxInfo(1) <> "" Then
          Faxname = Left(JobFolder & DTName & "-" & FaxInfo(0) & ", " & FaxInfo(1), 255) & ".tif"
        Else
          Faxname = Left(JobFolder & DTName & "-" & FaxInfo(0) & FaxInfo(1), 255) & ".tif"
        End If
        fso.getfile(JobFolder & myFile.FileName).Move (Faxname)
        IndexName = JobFolder & JobNo & "__Fax In.csv"
        sFaxIndex Faxname, FaxInfo
      Else 'it's not a fax, just an email
        sSendorReceive
        DTName = Format(email.ReceivedTime, "yymmdd_hhmmss")
        CleanName = fStripIllegalChar(email.Subject)
        EmailName = Left(JobFolder & DTName & "-" & CleanName, 251) & ".msg"
        If fFileExists(EmailName) Then 'already have an email with the same name
          MsgBox "Email name" & DTName & "-" & CleanName & " exists in correspondence folder, please rename"
          Exit Sub
        Else
          email.SaveAs (EmailName)
        End If
        sWriteIndex 'create entry in a csv file to index emails and faxes
      End If
      email.Delete 'move to deleted item, we can always move back to inbox if needed
    ElseIf mySelection.Item(i).Class = olJournal Then 'to do-journal archiving (code not started)
      Set journal = mySelection.Item(i)
      sJournalEntry
    Else
      MsgBox "Must be a mail or journal entry"
      Exit Sub
    End If
  Next i
  
  'cleanup
  Set myOlApp = Nothing
  Set mySelection = Nothing
  Set fso = Nothing
End Sub

Private Sub sWriteIndex()
'***************************************************
'create a "summary" csv file that can be opened with excel to
'quickly look for emails. Creates separate csv for sent or received
'***************************************************

  Dim Attachments As String
  Dim FileNumber As Integer
    
  Attachments = ""
  If email.Attachments.count > 0 Then Attachments = fAttachmentList
  FileNumber = FreeFile
  If fso.FileExists(IndexName) = True Then
    Open IndexName For Append As #FileNumber
  Else
    Open IndexName For Append As #FileNumber
    If Left(Right(IndexName, 6), 2) = "In" Then
      Write #FileNumber, "File Name", "Subject", "Received By", "Sent To", _
              "Date Received", "From Name", "From Email", "Date Sent", "Attachments"
    Else: Write #FileNumber, "File Name", "Subject", "Sent To", "Sent To Email," _
              ; "From Name", "From Email", "Date Sent", "Attachments"
    End If
  End If
  If Left(Right(IndexName, 6), 2) = "In" Then
    Write #FileNumber, _
      DTName, _
      email.Subject, _
      email.ReceivedByName, _
      email.To, _
      email.ReceivedTime, _
      email.SenderName, _
      fGetEmailAddressReply, _
      email.SentOn, _
      Attachments
  Else: Write #FileNumber, _
      DTName, _
      email.Subject, _
      email.To, _
      fSentToList, _
      email.SenderName, _
      fGetEmailAddressReply, _
      email.SentOn, _
      Attachments
  End If
  Close #FileNumber
End Sub

Private Sub sCheckJobNumber()
'***************************************************
'Verify Job number found in subject or entered from inputbox
'has a project folder created on the server. Must have folder
'to save email/fax
'***************************************************

  JobNo = InputBox(Prompt:="Please enter job number ", Default:=JobNo)
  If JobNo Like "" Then
    IsFolder = "Cancel"
    Exit Sub
  End If
  If fso.folderexists("R:\Product\" & JobNo & "\Corres\") Then
    where = "R:\Product\" & JobNo & "\Corres\"
  ElseIf fso.folderexists("R:\Bid\" & JobNo & "\Corres\") Then
    where = "R:\Bid\" & JobNo & "\Corres\"
  Else
    IsFolder = "NoFolder"
  End If
End Sub

Private Function fGetEmailAddressReply()
'***************************************************
'retrieve email address email was sent from
'***************************************************

  Dim objRecips As Outlook.Recipients
  Dim objRecip As Outlook.Recipient
  Dim objReply As MailItem
  Set objReply = email.reply
  Set objRecips = objReply.Recipients
  For Each objRecip In objRecips
    fGetEmailAddressReply = objRecip.Address
  Next objRecip
  Set objReply = Nothing
  Set objRecip = Nothing
  Set objRecips = Nothing
End Function

Private Sub sSendorReceive()
'***************************************************
'determine if email was sent or received
'***************************************************

  If email.ReceivedByName = "" Then
    JobFolder = where & "\Out\"
    IndexName = JobFolder & JobNo & "__Email Out.csv"
  Else
    JobFolder = where & "\In\"
    IndexName = JobFolder & JobNo & "__Email In.csv"
  End If
End Sub

Private Function fCheckJobName()
'***************************************************
'determine if project number is in our database and display
'input box for verification.
'Uses late binding.
'***************************************************

  Dim cnndb As Object
  Dim myrs As Object
  Dim MySql As String
  Dim verify As Integer
  
  Set cnndb = CreateObject("ADODB.connection")
  cnndb.ConnectionString = "Provider=MSDASQL; Driver={SQL Server}; Server=LGSDS01\AXIUM; " & _
                            "Database=Ajera; UID=; PWD=;"
  cnndb.Open
  Set myrs = CreateObject("ADODB.Recordset")
  MySql = "SELECT projNum, projName, vecDescription " & _
          "FROM LGS_JobList " & _
          "WHERE projNum='" & JobNo & "'"
  
  Set myrs = cnndb.Execute(MySql)
  If myrs.EOF = True Then
    verify = MsgBox("Cannot find " & JobNo & " in timesheet database, continue?" _
          , vbYesNo, "Verify Information")
  Else
    verify = MsgBox(JobNo & Chr(13) & myrs(1).Value _
          & Chr(13) & "for" & Chr(13) & myrs(2).Value _
          & Chr(13) & Chr(13) & "Is this correct?" _
          , vbYesNo, "Verify Information")
  End If
  If verify <> 6 Then IsFolder = "Cancel"
  cnndb.Close
  Set cnndb = Nothing
  Set myrs = Nothing
End Function

Private Function fAttachmentList()
'***************************************************
'create a list of attached files names to be used
'in csv summary file.
'***************************************************

  Dim AList As String
  Dim Attach As Attachment
  
  For Each Attach In email.Attachments
    If Attach.Type <> olOLE Then
      AList = AList & Attach.FileName & "; "
    End If
  Next Attach
  fAttachmentList = Left(AList, Len(AList) - 2)
End Function

Private Function fSentToList()
'***************************************************
'create a list of email addresses that email was sent to
'for use in csv summary files.
'***************************************************

  Dim myRecipient As Recipient
  Dim RList As String
  
  For Each myRecipient In email.Recipients
    RList = RList & myRecipient.Address & "; "
  Next myRecipient
  fSentToList = Left(RList, Len(RList) - 2)
End Function

Private Sub sFaxIndex(Faxname As String, FaxInfo() As String)
'***************************************************
'create a "summary" csv file that can be opened with excel to
'quickly look for faxes. Currently only handles received faxes
'***************************************************

  Dim FileNumber As Integer
  
  FileNumber = FreeFile
  If fso.FileExists(IndexName) = True Then
    Open IndexName For Append As #FileNumber
  Else
    Open IndexName For Append As #FileNumber
    Write #FileNumber, "Fax Name", "Sent To", "Sent By", "Company", "Received", "Number of Pages"
  End If
  Write #FileNumber, _
    DTName, _
    email.ReceivedByName, _
    FaxInfo(0), _
    FaxInfo(1), _
    FileDateTime(Faxname), _
    fNumPages(Faxname)
  Close #FileNumber
End Sub

Private Function fNumPages(Faxname As String)
'***************************************************
'open fax .tif file to determine number of pages in fax
'***************************************************

  Dim miDoc As Object
  'Dim miDoc As MODI.Document
  
  Set miDoc = CreateObject("MODI.Document")
  'Set miDoc = New MODI.Document
  miDoc.Create (Faxname)
  fNumPages = miDoc.Images.count
  Set miDoc = Nothing
End Function

Private Sub sJournalEntry()
'***************************************************
'this will be used for archiving journal entries
'currently not in use.
'***************************************************

  MsgBox "journal"
End Sub

Private Function fStripIllegalChar(strInput)
'***************************************************
'function that removes illegal file system
'characters.
'***************************************************
  Dim RegX As Object
  'special regex chars aka metacharacters = [\^$.|?*+()
  'invalid file characters = \ / : * ? " < > |
  Set RegX = CreateObject("VBScript.RegExp")
  RegX.Pattern = "[\\/:\*\?<>\|]"
  RegX.IgnoreCase = True
  RegX.Global = True
  strInput = RegX.Replace(strInput, "")
  RegX.Pattern = "[" & """" & "]"
  RegX.IgnoreCase = True
  RegX.Global = True
  fStripIllegalChar = RegX.Replace(strInput, "''")
  Set RegX = Nothing
End Function

Private Function fFileExists(ByVal PathName As String) As Boolean
'***************************************************
'verify a file exists in a certain location
'***************************************************

  On Error Resume Next
  fFileExists = (GetAttr(PathName) And vbDirectory) = 0
End Function

 

[teaaddict]

CSFEng
Thanks for the code I would have taken me months to write something like this. But you have given me the building blocks to do everything I want to.

I like the database for tracking mails.

Our QA is keen to log all correspondence automatically.

More stars for you.

 

[WMO]

CSFEng,
Thanks for posting. As teaaddict stated it is a good place to start. Much appreciated.
-Mark

 

[CFSEng]

You are all welcome. My next plan is to write all this information into a database, so it can easily be retrieved from our project web pages. Since I already laid out the foundation for the information in creating a .csv file, it should be rather easy to change that to writing to a database.

If anyone has any suggestions for improvements let me know.