Extract subject with specific keyword, sender, date/time, export to Excel

[Lemmein]

I've never asked a question like this before so I apologize in advance. Long story short, I haven't worked w. VBA for 2 years now. I lost all of my notes and data due to what can only be called a personal tragedy. I've spent 2 days attempting to figure this out on my own using this great site and a couple others but after trying to tweak several different modules from the 3 sites and having no success, I'm basically just spinning my wheels and not making any progress. I tried calling one ex-coworker but he's OCONUS right now.
Description:
I need to process incoming emails with a keyword in the subject, (i.e. Logging), export the sender, subject, date&time the email was received to
an excel spreadsheet (C:\data\Logging\logging.xlsc), then move the email to a subfolder (Logging) in the current mailbox. This processing should be done automatically. Normally I would insert the code I've tried, but I basically have nothing but overcooked spaghetti code that doesn't do anything. I apologize for this question but I'm in a bind and I need to get this working. I do plan on taking some online training this week and next week to get the basics back, but I need a solution tomorrow if possible, Tuesday at the latest.

[gmayor]

This is very similar to code I have posted previously. Use a rule to identify the messages as they arrive, run the script 'ExtractLoggingData', and move the message to your folder of choice. The macro will create the path and workbook if not present. I have included a test macro so that you can test the code with a selected message.


Option Explicit

Private strDate As String
Private strTime As String
Private strEmail As String
Private strSubject As String
Private strValues As String
Private vValues As Variant
Private ConnectionString As String
Private strSQL As String
Private CN As Object
Private xlApp As Object
Private xlWB As Object
Private bxlStarted As Boolean
Private i As Long
Private Const strTitles As String = "Date|Time|E-Mail|Subject"
Private Const strWorkbook As String = "Logging.xlsx"
Private Const strPath As String = "C:\Data\Logging\"

Sub Test()
Dim olMsg As MailItem
On Error Resume Next
Select Case Outlook.Application.ActiveWindow.Class
Case olInspector
Set olMsg = ActiveInspector.currentItem
Case olExplorer
Set olMsg = Application.ActiveExplorer.Selection.Item(1)
End Select
ExtractLoggingData olMsg
lbl_Exit:
Exit Sub
End Sub

Sub ExtractLoggingData(Item As MailItem)
'Graham Mayor - https://www.gmayor.com - Last updated - 11 May 2020
If TypeName(Item) = "MailItem" Then
strEmail = Item.SenderEmailAddress
strDate = Format(Item.ReceivedTime, "dd/MM/yyyy")
strTime = Format(Item.ReceivedTime, "h:mm am/pm")
strSubject = Item.Subject
strValues = strDate & "', '" & _
strTime & "', '" & _
strEmail & "', '" & _
strSubject
If Not FileExists(strPath & strWorkbook) = True Then xlCreateBook strWorkbook:=strPath & strWorkbook, strTitles:=strTitles
WriteToWorksheet strWorkbook:=strPath & strWorkbook, strRange:="Sheet1", strValues:=strValues
End If
lbl_Exit:
Exit Sub
End Sub

Private Function WriteToWorksheet(strWorkbook As String, _
strRange As String, _
strValues As String)
ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
Set CN = CreateObject("ADODB.Connection")
Call CN.Open(ConnectionString)
Call CN.Execute(strSQL, , 1 Or 128)
CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function

Private Sub xlCreateBook(strWorkbook As String, strTitles As String)
CreateFolders strPath
vValues = Split(strTitles, "|")
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Set xlApp = CreateObject("Excel.Application")
bxlStarted = True
End If
On Error GoTo 0
Set xlWB = xlApp.Workbooks.Add
With xlWB.Sheets(1)
For i = 0 To UBound(vValues)
.cells(1, i + 1) = vValues(i)
Next i
End With
xlWB.SaveAs strWorkbook
xlWB.Close 1
If bxlStarted Then
xlApp.Quit
Set xlApp = Nothing
Set xlWB = Nothing
End If
lbl_Exit:
Exit Sub
End Sub

Private Function CreateFolders(strPath As String)
'An Outlook macro by Graham Mayor
Dim strTempPath As String
Dim lngPath As Long
Dim VPath As Variant
VPath = Split(strPath, "\")
strPath = VPath(0) & "\"
For lngPath = 1 To UBound(VPath)
strPath = strPath & VPath(lngPath) & "\"
If Not FolderExists(strPath) Then MkDir strPath
Next lngPath
lbl_Exit:
Exit Function
End Function

Private Function FolderExists(fldr) As Boolean
'An Outlook macro by Graham Mayor
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If (FSO.FolderExists(fldr)) Then
FolderExists = True
Else
FolderExists = False
End If
lbl_Exit:
Exit Function
End Function

Private Function FileExists(filespec) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(filespec) Then
FileExists = True
Else
FileExists = False
End If
lbl_Exit:
Exit Function
End Function

[Lemmein]

Awesome! TYVM! I’ll test it first thing in the morning. YOU ROCK!

[Lemmein]

WELP! I just found out that I no longer need this because a different route is going to be used, which means I wasted my weekend and some of your time too (sort of). What I AM going to do is save this, use it as an example of how to write good code, and break it down, see if I can get the basics back, and understand everything in all of the functions. So at this point, your code is still going to be very helpful, since as I said I'll be using it as a 'how to'. Also I haven't gone to your site yet but based on what I've seen you may want to put together a QND pdf and advertise/sell it for people who are either just starting or are getting back into VBA after a long time away. Put some of your code examples/functions, comments explaining why/how/what, etc.. I'm serious, I think people, EVEN ME, would buy it! I usually prefer to learn on my own and I've been geeking out for longer than I like to remember, but again, with something as awesome, flexible, and powerful as VBA, while there are many resources out there, it seems to me as if you could provide something and actually get some profit from it, assuming you're interested. Thanks again for your help. UPDATE: Came back to edit this after visiting your site. Sent you a little thank you via PP.