Option Explicit Dim parsedArray(0 To 7) As String Sub ExportToExcel() On Error Resume Next Dim appExcel As Excel.Application Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim rng As Excel.Range Dim strSheet As String Dim strPath As String Dim theRow As Integer Dim theColumn As Integer Dim msg As Outlook.MailItem Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder Dim destination As Outlook.MAPIFolder Dim itm As Object theRow = 1 theColumn = 1 Dim strBody As String Dim strName As String Dim strEmail As String Dim strSize As String Dim strType As String Dim strMonth As String Dim strDate As String Dim strOrganization As String strSheet = "GroupsInfoRequests.xlsx" strPath = "C:\Users\Administrator.Laptop-1\Documents\" strSheet = strPath & strSheet 'Debug.Print strSheet 'this is the export folder Set nms = Application.GetNamespace("MAPI") 'Set fld = nms.PickFolder 'this gives me a dialog box to select the folder 'todo make it inbox everytime Set fld = nms.GetDefaultFolder(olFolderInbox) Set destination = fld.Folders("GroupsInfo") If fld Is Nothing Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub ElseIf fld.DefaultItemType <> olMailItem Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub ElseIf fld.Items.Count = 0 Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub End If 'Open and activate Excel Set appExcel = CreateObject("Excel.Application") appExcel.Workbooks.Open (strSheet) Set wkb = appExcel.ActiveWorkbook Set wks = wkb.Sheets(1) wks.Activate appExcel.Application.Visible = True 'get the last line in the workbook appExcel.Cells(1, 1).Select If Len(appExcel.Cells(1, 1).Value) > 0 Then theRow = 1 + appExcel.ActiveCell.End(xlDown).Row Else theRow = 1 End If 'MsgBox (theRow) For Each itm In fld.Items 'Exit Sub Set msg = itm If msg.Subject = "Groups Info Requested" Then 'i have subject and body 'i want to parse the body into different fields ParseBody (msg.Body) 'c1 = name appExcel.Cells(theRow, theColumn).Value = parsedArray(6) 'can i trim here? theColumn = theColumn + 1 'c2 = phone appExcel.Cells(theRow, theColumn).Value = parsedArray(1) theColumn = theColumn + 1 'c3 = email appExcel.Cells(theRow, theColumn).Value = parsedArray(2) theColumn = theColumn + 1 'c4 = size appExcel.Cells(theRow, theColumn).Value = parsedArray(3) theColumn = theColumn + 1 'c5 = type appExcel.Cells(theRow, theColumn).Value = parsedArray(4) theColumn = theColumn + 1 'c6 = month appExcel.Cells(theRow, theColumn).Value = parsedArray(5) theColumn = theColumn + 1 'c7 = date appExcel.Cells(theRow, theColumn).Value = msg.SentOn theColumn = theColumn + 1 'c8 = contacted appExcel.Cells(theRow, theColumn).Value = "No" theColumn = theColumn + 1 'c9 = organization appExcel.Cells(theRow, theColumn).Value = parsedArray(7) theColumn = theColumn + 1 theRow = theRow + 1 theColumn = 1 msg.Delete End If Next itm End Sub Sub ParseBody(strBody As String) Dim regex As Object 'Dim regexMatch As Object Dim strName As Object Dim strPhone As Object Dim strEmail As Object Dim strSize As Object Dim strType As Object Dim strMonth As Object Dim strContact As Object Dim strOrganization As Object 'Dim Matches(7) As Variant Set regex = CreateObject("VBScript.RegExp") 'name With regex .MultiLine = True .Global = False .IgnoreCase = True .Pattern = "Contact:.*" End With Set strName = regex.Execute(strBody) Dim strName1 As String strName1 = strName(0) strName1 = Right(strName1, (Len(strName1) - 9)) 'phone regex.Pattern = "Phone:.*" Set strPhone = regex.Execute(strBody) Dim strPhone1 As String strPhone1 = strPhone(0) strPhone1 = Right(strPhone1, (Len(strPhone1) - 7)) 'email regex.Pattern = "Email:.*" Set strEmail = regex.Execute(strBody) Dim strEmail1 As String strEmail1 = strEmail(0) strEmail1 = Right(strEmail1, (Len(strEmail1) - 6)) 'size regex.Pattern = "Size:.*" Set strSize = regex.Execute(strBody) Dim strSize1 As String strSize1 = strSize(0) strSize1 = Right(strSize1, (Len(strSize1) - 6)) 'type regex.Pattern = "Type:.*" Set strType = regex.Execute(strBody) Dim strType1 As String strType1 = strType(0) strType1 = Right(strType1, (Len(strType1) - 6)) 'month regex.Pattern = "Month:.*" Set strMonth = regex.Execute(strBody) Dim strMonth1 As String strMonth1 = strMonth(0) strMonth1 = Right(strMonth1, (Len(strMonth1) - 7)) 'contact regex.Pattern = "Contact:.*" Set strContact = regex.Execute(strBody) Dim strContact1 As String strContact1 = strContact(0) strContact1 = Right(strContact1, (Len(strContact1) - 9)) 'Organization regex.Pattern = "Group Name:.*" Set strOrganization = regex.Execute(strBody) Dim strOrganization1 As String strOrganization1 = strOrganization(0) strOrganization1 = Right(strOrganization1, (Len(strOrganization1) - 12)) Dim temp As String parsedArray(0) = strName1 parsedArray(1) = strPhone1 parsedArray(2) = strEmail1 parsedArray(3) = strSize1 parsedArray(4) = strType1 parsedArray(5) = strMonth1 parsedArray(6) = strContact1 parsedArray(7) = strOrganization1 'ParseBody = parsedArray End Sub