Loop new messages containing a table, populate a dynamic array, paste array to Excel

Hi everyone,

I have tried to solve the following puzzle for awhile and am looking for some insights.

The situation is as follows. I receive several emails per day to a specified email account. The mail box does not receive any other messages than the ones I am interested but in theory it could. Each and every email contain a data table with a header, where the number of rows and columns alter from one email to another. The message body contains just a table. In each and every email, the column headers are named systematically/uniquely and I am only interested in three of them (there could be more than three depending on the email). Let's call them USER, TASK, and NUMBER. The number of rows (observations) vary between emails but not within emails; i.e. the three columns I am interested always have the same number of rows per unique email.

In order to make things complicated, I would prefer the application to run silently on the background without prompting the user every now and then. Also, I am not sure if this is feasible, the macro would run always when one opens Outlook for the first time as well as when new message arrives (if this makes the application really heavy, one can always use a timer that will run the code let's say every 15 minutes).

Steps:
1. Look Unread mailitems containing a table
2. Loop through all those messages in the mailbox and populate an array
3. Open a new excel file, call the array from the VBA memory, save the file, and close it
4. Open a new mailitem, enter a recipient, add attachment, and send
5. Run again when a new email arrives or after a specified time interval

First of all, is this even possible?

Below you can see the code showing where I need help.

Thank you for taking your time to read through the message.

Any help is welcome and much appreciated!

Sub test() 
     
    Dim ns As NameSpace 
    Dim item As MailItem 
    Dim inbox As MAPIFolder 
    Dim sub_folder As MAPIFolder 
    Dim rows As Variant 
    Dim numberofColumns As Long 
    Dim numberofRows As Long 
    Dim numberofColumnsPreviousMsg As Long 
    Dim numberofRowsPreviousMsg As Long 
    Dim headerValues As Variant 
    Dim headerRow() As String 
    Dim data() As String 
    Dim h As Long, j As Long 
    Dim xlApp As Object 
     
    Set xlApp = CreateObject("Excel.Application") 
    Set ns = GetNamespace("MAPI") 
    Set inbox = ns.GetDefaultFolder(olFolderInbox) 
    Set sub_folder = inbox.Folders("TEST") 
     
    For Each item In sub_folder.Items 
        If TypeOf item Is MailItem Then 
            If (item.UnRead) Then 
                Set doc = ActiveInspector.WordEditor 
                If doc.Tables.Count = 0 Then 
                     ' tokenize each line of the email
                    rows = Split(item.Body, vbCrLf) 
                     
                     ' calculate array size
                    numberofColumns = Len(rows(0)) - Len(Replace(rows(0), Chr(9), "")) 
                    numberofRows = UBound(rows) + 1 
                     
                     ' put header row into array
                    Redim headerRow(1 To numberofColumns) 
                    headerValues = Split(rows(0), Chr(9)) 
                     'TODO find the position of USER, TASK, and NUMBER columns
                     ' I tried something like this but it didn't work. Any ideas why is that?
                     ' n = Application.Match(NUMBER, data, 0)
                     ' n = Application.Match(TASK, data, 0)
                     ' n = Application.Match(USER, data, 0)
                     
                     'Maybe we could do something like this? How can I return the column number for for a given header?
                     ' For i = 1 To numberofColumns
                     '    headerRow(i) = Trim$(headerValues(i - 1))
                     'Next i
                     
                     ' calculate data array size excluding the headers
                    numberofRows = numberofRows - 1 
                     'This is the most important part. How can I populate the array for all the messages containing a table at once and not just for one at the time?
                     ' put data into array
                    Redim data(1 To numberofRows, 1 To numberofColumns) 
                     
                    For h = 2 To numberofRows ' (do not include the headers)
                        For j = 1 To numberofColumns 
                            data(h, j) = Trim$(Split(rows(h), Chr(9))(j - 1)) 
                        Next j 
                    Next h 
                     
                     
                     'Open and populate new excel
                     'This procedure will always open a new excel spread sheet instead of using the existing one and just append to the range
                     'We would have to populate the data() array for each item in the specified folder, but unfortunately I am not sure how to do this. Any insights?
                    With xlApp 
                        .Visible = True 
                        .EnableEvents = False 
                    End With 
                     
                    Set wb = xlApp.workbooks.Add 
                     'I tried to wb.worksheet(1).Range(Cells(1,1), Cells(NumberOfRows, NumberOfColumns) but it didn't work. Any ideas why?
                    wb.worksheets(1).Range("a1:h5") = data() '
                End If 
                 
                 
                 
            End If 
        End If 
         
         
    Next

             'Save and close the workbook containing data
            application.displayalerts = false
            wb.SaveAs Filename:="C:\Data\" & BookName, FileFormat:= _
            xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
            , CreateBackup:=False
            wb.close
            application.displayalerts = True

   
      Set olNewMail = CreateItem(olMailItem) 
     
     'Add values to the properties of the created mail and attach
     'the report to the outgoing mail.
     With olNewMail 
        .Recipients.Add "type email address here" 
        .CC = "" 
        .BCC = "" 
        .Subject = "Data" 
        .Body = "" 
         ' Only attach the new workbook
        With .Attachments 
            .Add App.Path & "\WeekReport.doc" 
            .Item(1).DisplayName = "Data" 
        End With 
        .Save 
        .Display 
    End With 

End Sub

I am especially interested to know how to continue populating the same data array? Any ideas?