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