Class action lawsuits come with months, if not years, of effort to collect attorney’s fees out of settlements. Increasingly lawyers find themselves in need of processing thousands of email messages to account for their time. Despite the capabilities of eDiscovery within mail systems, the reality is that us – people – tend to store email in a variety of ways. One of our clients in Miami just had to go through something like this, and like many attorneys he was unsure what to do next. He new he needed to review a thousands of emails (as did his co-counsels), assign billing to them, and submit them. However, all that came with a risk. Surely, among the various messages there are comments, reactions, and thoughts that could be misconstrued. For this, the emails would need to be redacted.
For anyone who has done eDiscovery work, it’s opposite of redaction. For anyone who has done redactive work, it’s usually not something one does to the entire body of all emails like this request shaped out to be. Fortunately, the problem reached one of our solution consultants who had a simple answer: eDiscovery and an export to Excel.
During the information gathering stage we learned that the data was stored in a prepared Personal Folder Files (PSTs) and possibly in a case management software in the form of individual EML files. After further digging we were able to translate the vision of the attorneys involved into a technical answer: a spreadsheet that contains the relevant metadata and subjects of each message. That would be sufficient to do the job. To do this quickly we spun up an Amazon Web Services instance with plenty of horsepower and got busy putting together some code.
Now, experience has taught us that you have to be ready for the unexpected. There was agreement that there is likely more to come out of this, so we prepared a very simple Outlook Macro to save each highlighted message as a row in an Excel document. Ran it, tested it, and submitted it within a few hours. At the time we had a budget of $3,500 and 1 week. At about 2 billable hours in we had results that seemingly satisfied the attorneys. Cool.
Apparently the results impressed because the scope grew exponentially. Turned out that the PST file we worked with was just the tip of the iceberg, and the real treasure trove of emails was in the lead attorneys mailbox. Not organized or structured – just as a lonely search result in an open Outlook window. Now, the trouble with this kind of thing is that Outlook searches depend on cached mode, Windows indexing, and the oomph of the machine. With a 50Gb mailbox, a 3 month cache, and aging equipment none of that was going to work. Queue Amazon Web Services once again along with Microsoft Office 365 eDiscovery.
Because this firm was already a managed services client we had our full array of site and cloud application security tools deployed. This meant proper Office 365 plans, authorized access, and the means to execute. We performed eDiscovery searches in lieu of the Outlook search being used and waited for the results. Soon enough those arrived, and were transferred – in PST form – to our AWS EC2 instances for further processing. There all we had to do was massage out the message corruption (and there was some when you deal with this much data) and create our spreadsheets.
The project was completed 4 days ahead of schedule and at about 30% of the original budget. Here is the Outlook Macro thad did the bulk of the heavy lifting:
Outlook VBS Macro
Option Explicit
Sub CopyToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim obj As Object
Dim strColA, strColB, strColC, strColD, strColE, strColF, strColG, strColH, strColI, strColJ, strColK, strColL, strColM, strColN, strColO, strColP, strColQ, strColR, strColS, strColT, strColU, strColV, strColW, strColX, strColY, strColZ, strColAA, strColAB, strColAC, strColAD, strColAE, strColAF, strColAG, strColAH, strColAI, strColAJ, strColAK, strColAL, strColAM, strColAN, strColAO, strColAP, strColAQ As String
' Get Excel set up
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'## Open a specific workbook to input the data
'the path of the workbook under the windows user account
'enviro = CStr(Environ("USERPROFILE"))
' strPath = enviro & "\Documents\test.xlsx"
' Set xlWB = xlApp.Workbooks.Open(strPath)
' Set xlSheet = xlWB.Sheets("Sheet1")
'## End Specific workbook
'## Use New Workbook
Set xlWB = xlApp.Workbooks.Add
Set xlSheet = xlWB.Sheets("Sheet1")
'## end use new workbook
' Add column names
xlSheet.Range("A1") = "Sent"
xlSheet.Range("B1") = "SentOn"
xlSheet.Range("C1") = "Sender Name"
' xlSheet.Range("D1") = "Sender Address"
xlSheet.Range("E1") = "Subject"
xlSheet.Range("F1") = "To"
xlSheet.Range("G1") = "Recipients"
xlSheet.Range("H1") = "CC"
xlSheet.Range("I1") = "BCC"
xlSheet.Range("J1") = "Size"
xlSheet.Range("K1") = "Attachments"
xlSheet.Range("L1") = "Importance"
xlSheet.Range("M1") = "Message Class"
xlSheet.Range("N1") = "Creation Time"
xlSheet.Range("O1") = "Received Time"
xlSheet.Range("P1") = "Class"
xlSheet.Range("Q1") = "Parent"
xlSheet.Range("R1") = "Read Receipt Requested"
xlSheet.Range("S1") = "ReceivedByEntryID"
xlSheet.Range("T1") = "Received By Name"
xlSheet.Range("U1") = "ReceivedOnBehalfOfEntryID"
xlSheet.Range("V1") = "RecivedOnBehalfOfName"
xlSheet.Range("W1") = "Billing Info"
xlSheet.Range("X1") = "Categories"
xlSheet.Range("Y1") = "AutoForwarded"
xlSheet.Range("Z1") = "ConversationID"
xlSheet.Range("AA1") = "ConversationIndex"
xlSheet.Range("AB1") = "ConversationTopic"
xlSheet.Range("AC1") = "DeferredDeliveryTime"
' xlSheet.Range("AD1") = "BodyFormat"
' xlSheet.Range("AE1") = "Body"
' xlSheet.Range("AF1") = "HTMLBody"
xlSheet.Range("AG1") = "lastModTime"
xlSheet.Range("AH1") = "Mileage"
xlSheet.Range("AI1") = "OutlookInternalVersion"
xlSheet.Range("AJ1") = "OutlookVersion"
xlSheet.Range("AK1") = "ReplyRecipientNames"
' xlSheet.Range("AL1") = "RTFBody"
xlSheet.Range("AM1") = "SenderEmailType"
xlSheet.Range("AN1") = "SendUsingAccount"
xlSheet.Range("AO1") = "Sensitivity"
xlSheet.Range("AP1") = "Unread"
xlSheet.Range("AQ1") = "UserProperties"
' Process the message record
On Error Resume Next
'Find the next empty line of the worksheet
rCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row
'needed for Exchange 2016. Remove if causing blank lines.
rCount = rCount + 1
' get the values from outlook
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
For Each obj In Selection
Set olItem = obj
'collect the fields
strColA = olItem.Sent
strColB = olItem.SentOn
strColC = olItem.SenderName
' strColD = olItem.SenderEmailAddress
strColE = olItem.Subject
strColF = olItem.To
strColG = olItem.Recipients
strColH = olItem.CC
strColI = olItem.BCC
strColJ = olItem.Size
strColK = olItem.Importance
strColL = olItem.Attachments
strColM = olItem.MessageClass
strColN = olItem.CreationTime
strColO = olItem.ReceivedTime
strColP = olItem.Class
strColQ = olItem.Parent
strColR = olItem.ReadReceiptRequested
strColS = olItem.ReceivedByEntryID
strColT = olItem.ReceivedByName
strColU = olItem.ReceivedOnBehalfOfEntryID
strColV = olItem.ReceivedOnBehalfOfName
strColW = olItem.BillingInformation
strColX = olItem.Categories
strColY = olItem.AutoForwarded
strColZ = olItem.ConversationID
strColAA = olItem.ConversationIndex
strColAB = olItem.ConversationTopic
strColAC = olItem.DeferredDeliveryTime
'Body Stuff
' strColAD = olItem.BodyFormat
' strColAE = olItem.Body
' strColAF = olItem.HTMLBody
strColAG = olItem.LastModificationTime
strColAH = olItem.Mileage
strColAI = olItem.OutlookInternalVersion
strColAJ = olItem.OutlookVersion
strColAK = olItem.ReplyRecipientNames
' strColAL = olItem.RTFBody
' Final Meta
strColAM = olItem.SenderEmailType
strColAN = olItem.SendUsingAccount
strColAO = olItem.Sensitivity
strColAP = olItem.UnRead
strColAQ = olItem.UserProperties
'### Get all recipient addresses
' instead of To names
Dim strRecipients As String
Dim Recipient As Outlook.Recipient
For Each Recipient In olItem.Recipients
strRecipients = Recipient.Address & "; " & strRecipients
Next Recipient
strColD = strRecipients
'### end all recipients addresses
'### Get the Exchange address
' if not using Exchange, this block can be removed
Dim olEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Dim recip As Outlook.Recipient
Set recip = Application.Session.CreateRecipient(strColB)
If InStr(1, strColB, "/") > 0 Then
' if exchange, get smtp address
Select Case recip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColB = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olOutlookContactAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColB = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = recip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
strColB = olEU.PrimarySmtpAddress
End If
End Select
End If
' ### End Exchange section
'write them in the excel sheet
xlSheet.Range("A" & rCount) = strColA
xlSheet.Range("B" & rCount) = strColB
xlSheet.Range("C" & rCount) = strColC
' xlSheet.Range("D" & rCount) = strColD
xlSheet.Range("E" & rCount) = strColE
xlSheet.Range("F" & rCount) = strColF
xlSheet.Range("G" & rCount) = strColG
xlSheet.Range("H" & rCount) = strColH
xlSheet.Range("I" & rCount) = strColI
xlSheet.Range("J" & rCount) = strColJ
xlSheet.Range("K" & rCount) = strColK
xlSheet.Range("L" & rCount) = strColL
xlSheet.Range("M" & rCount) = strColM
xlSheet.Range("N" & rCount) = strColN
xlSheet.Range("O" & rCount) = strColO
xlSheet.Range("P" & rCount) = strColP
xlSheet.Range("Q" & rCount) = strColQ
xlSheet.Range("R" & rCount) = strColR
xlSheet.Range("S" & rCount) = strColS
xlSheet.Range("T" & rCount) = strColT
xlSheet.Range("U" & rCount) = strColU
xlSheet.Range("V" & rCount) = strColV
xlSheet.Range("W" & rCount) = strColW
xlSheet.Range("X" & rCount) = strColX
xlSheet.Range("Y" & rCount) = strColY
xlSheet.Range("Z" & rCount) = strColZ
xlSheet.Range("AA" & rCount) = strColAA
xlSheet.Range("AB" & rCount) = strColAB
xlSheet.Range("AC" & rCount) = strColAC
' xlSheet.Range("AD" & rCount) = strColAD
' xlSheet.Range("AE" & rCount) = strColAE
' xlSheet.Range("AF" & rCount) = strColAF
xlSheet.Range("AG" & rCount) = strColAG
xlSheet.Range("AH" & rCount) = strColAH
xlSheet.Range("AI" & rCount) = strColAI
xlSheet.Range("AJ" & rCount) = strColAJ
xlSheet.Range("AK" & rCount) = strColAK
' xlSheet.Range("AL" & rCount) = strColAL
xlSheet.Range("AM" & rCount) = strColAM
xlSheet.Range("AN" & rCount) = strColAN
xlSheet.Range("AO" & rCount) = strColAO
xlSheet.Range("AP" & rCount) = strColAP
xlSheet.Range("AQ" & rCount) = strColAQ
'Next row
rCount = rCount + 1
' size the cells
xlSheet.Columns("A:E").EntireColumn.AutoFit
' xlSheet.Columns("C:C").ColumnWidth = 100
' xlSheet.Columns("D:D").ColumnWidth = 30
xlSheet.Range("A2").Select
xlSheet.Columns("A:E").VerticalAlignment = xlTop
Next
xlApp.Visible = True
' to save but not close
'xlWB.Save
' to save and close
' xlWB.Close 1
' If bXStarted Then
' xlApp.Quit
' End If
' end save and close
Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlSheet = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
