VBA: Outlook Mailbox Folder, Count Keywords in Subject & Body and Export to Excel
<p>I will preface this by stating that I have no VBA knowledge, I can sort of read it but I certainly can't write it. I have also spent a good amount of time looking for previously answered questions that will provide me with a solution but have not found anything similar enough for me to adapt it with my limited knowledge.</p>

<p>What I am trying to do is write a VBA script that will read the subject of all emails in an Outlook folder, count predefined keywords and write the result to separate cells in an Excel spreadsheet. Additionally, read the body and copy an entire sentence that appears after a phrase to a cell in Excel. </p>

<p>These emails have a fixed format:<br>
<b>Subject</b>: <br>[keyword, three possibilities] [keyword, three possibilities] ["!" or "?" or nothing]<br>
<b>Body</b>:<br>
Search Engine: [text to copy, single word]<br>
Keyword: [text to copy, a single sentence on one continuous line]</p>

<p>Below is code I believe to be relevant to what I'm trying to do but can't piece together into a single script. For reading a single, selected email in Outlook and writing the subject to separate Excel cells based on a pre-defined pattern:</p>

<pre><code>Option Explicit
 Private Const xlUp As Long = -4162

 Sub CopyToExcel()
 Dim olItem As Outlook.MailItem
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim vText, vText2, vText3 As Variant
 Dim sText As String
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim Reg1 As Object
 Dim M1 As Object
 Dim M As Object

enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
 strPath = enviro &amp; "\Documents\Tally.xlsx"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err &lt;&gt; 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 the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Sheet1")
     Set olItem = Application.ActiveExplorer().Selection()

    'Find the next empty line of the worksheet
     rCount = xlSheet.Range("B" &amp; xlSheet.Rows.Count).End(xlUp).Row
     rCount = rCount + 1

     sText = olItem.Subject

     Set Reg1 = CreateObject("VBScript.RegExp")
    ' \s* = invisible spaces
    ' \d* = match digits
    ' \w* = match alphanumeric

    With Reg1
        .Pattern = "((\w*)\s*(\w*)\s*(\w*))"
    End With
    If Reg1.test(sText) Then

' each "(\w*)" and the "(\d)" are assigned a vText variable
        Set M1 = Reg1.Execute(sText)
        For Each M In M1
           vText = Trim(M.SubMatches(1))
           vText2 = Trim(M.SubMatches(2))
           vText3 = Trim(M.SubMatches(3))
        Next
    End If

  xlSheet.Range("B" &amp; rCount) = vText
  xlSheet.Range("c" &amp; rCount) = vText2
  xlSheet.Range("d" &amp; rCount) = vText3

     xlWB.Close 1
     If bXStarted Then
         xlApp.Quit
     End If
     Set M = Nothing
     Set M1 = Nothing
     Set Reg1 = Nothing
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
 End Sub
</code></pre>

<p>A script that takes the date of an email and tallies the number of time it occurs:</p>

<pre><code>Const olFolderInbox = 6

Set objDictionary = CreateObject("Scripting.Dictionary")

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)

Set colItems = objFolder.Items

For Each objItem in colItems
    strDate = FormatDateTime(objItem.SentOn, vbShortDate)
    If objDictionary.Exists(strOnline) Then
        objDictionary.Item(strOnline) = objDictionary.Item(strOnline) + 1
    Else
        objDictionary.Add strOnline, "1"
    End If
Next

colKeys = objDictionary.Keys

For Each strKey in colKeys
    Wscript.Echo strKey, objDictionary.Item(strKey)
Next
</code></pre>

<p>And a simple If statement, if the subject has this, then do this(?):</p>

<pre><code>Dim strSubject As String
strSubject = Item.Subject
If strSubject Like "*example1*" or strSubject Like "*example2*" Then
</code></pre>

<p>Any help with this would be much appreciated as this is not my area of expertise.</p>