Here is one way to do it:
Using these instructions to all a rule to run a macro/script Outlook's Rules and Alerts: Run a Script (slipstick.com)
You need to turn on the ability to run a script via a rule when an email is received because it was turned off, Run-a-Script Rules Missing in Outlook (slipstick.com)
Right click a current email you want this to run for and select Rules > Create Rule then
https://imgur.com/9BR82mF
https://imgur.com/uO0hGfR
https://imgur.com/aDqObmT
https://imgur.com/4F4eg2Z
Then click Okay
Result when all is good https://imgur.com/BDi5Gsa, else there are other messages to help with why it couldn't add the email to your spreadsheet
Place this code in the ThisOutlookSession module under Microsoft Outlook Objects https://imgur.com/iiXe1Pa
Add Microsoft Excel 16.0 Object Library in Tools > References. (your library may be numbered differently depending on what version of Excel you are running)
Depending on the format of the email you're receiving, you may need to change the character used to indicate the end of the line in these lines of code:
employeeName = Left(employeeName, InStr(employeeName, vbCr) - 1)
departmentName = Left(departmentName, InStr(departmentName, vbCr) - 1)
I'm using the carriage return character.
Public Sub ParseTrainingEmail(trainingEmail As Outlook.MailItem)
' this is called by the rule created for a specific subject "Department employee email"
Dim excelFile As String
Dim employeeIndicator As String
Dim departmentIndicator As String
Dim employeeName As String
Dim departmentName As String
Dim excelApp As Excel.Application
Dim excelWB As Workbook
Dim excelWS As Worksheet
Dim excelLastEmployeeColRange As Range
Dim excelNewEmployeeColRange As Range
Dim excelMessage As String
Dim excelEmployeeStartingCol As Long
Dim excelEmployeeCol As Long
Dim excelEmployeeRow As Long
Dim departmentFound As Boolean
Dim employeeFound As Boolean
' place your specific values here
excelFile = "f:\temp\file1.xlsx"
employeeIndicator = "Employee:"
departmentIndicator = "Department:"
' find the information in the email
On Error GoTo MissingEmployeeInfo
employeeName = Right(trainingEmail.Body, Len(trainingEmail.Body) - (InStr(trainingEmail.Body, employeeIndicator) + Len(employeeIndicator)))
employeeName = Left(employeeName, InStr(employeeName, vbCr) - 1)
If InStr(trainingEmail.Body, employeeIndicator) = 0 Then GoTo MissingEmployeeInfo
On Error GoTo MissingDepartmentInfo
departmentName = Right(trainingEmail.Body, Len(trainingEmail.Body) - (InStr(trainingEmail.Body, departmentIndicator) + Len(departmentIndicator)))
departmentName = Left(departmentName, InStr(departmentName, vbCr) - 1)
If InStr(trainingEmail.Body, departmentIndicator) = 0 Then GoTo MissingDepartmentInfo
On Error GoTo ExcelProcessingError
excelMessage = ""
excelEmployeeStartingCol = 2 ' where should this macro start looking for the employee name
excelEmployeeRow = 1 ' in which row do the employee names appear
Set excelApp = New Excel.Application
Set excelWB = excelApp.Workbooks.Open(excelFile)
' search for the department worksheet in the workbook, comparing each sheet in caps to the extracted department name
departmentFound = False
For Each excelWS In excelWB.Worksheets
departmentFound = (UCase(excelWS.Name) = UCase(departmentName))
If departmentFound Then Exit For
Next
If Not departmentFound Then
' a matching department sheet name was not found
excelMessage = "A training email was received on " & trainingEmail.ReceivedTime & ", however, the department name: " & departmentName & " which was not found in the Excel file."
GoTo ExcelProcessingError
End If
' search for the employee in the worksheet, comparing each employee name in caps to the extracted employee name
employeeFound = False
excelEmployeeCol = excelEmployeeStartingCol
Do While Len(excelWS.Cells(1, excelEmployeeCol).Value) > 0
employeeFound = (UCase(excelWS.Cells(excelEmployeeRow, excelEmployeeCol).Value) = UCase(employeeName))
If employeeFound Then Exit Do
excelEmployeeCol = excelEmployeeCol + 1
Loop
' if the employee wasn't found then create a new column for the employee
If Not employeeFound Then
' copy the formatting of the last column that contained an employee
Set excelLastEmployeeColRange = excelWS.Cells(excelEmployeeRow, excelEmployeeCol - 1)
Set excelNewEmployeeColRange = excelWS.Cells(excelEmployeeRow, excelEmployeeCol)
excelLastEmployeeColRange.Copy
excelNewEmployeeColRange.PasteSpecial xlPasteFormats
' match the width as well
excelWS.Cells(excelEmployeeRow, excelEmployeeCol).ColumnWidth = excelWS.Cells(excelEmployeeRow, excelEmployeeCol - 1).ColumnWidth
excelWS.Cells(excelEmployeeRow, excelEmployeeCol).Value = employeeName
End If
excelWB.Close True
excelApp.Quit
MsgBox "A training email was receivied on " & trainingEmail.ReceivedTime & " and processed successfully for employee: " & employeeName & " in department: " & departmentName
Exit Sub
MissingEmployeeInfo:
MsgBox "A training email was receivied on " & trainingEmail.ReceivedTime & ", however, an employee name was not found in the email."
Exit Sub
MissingDepartmentInfo:
MsgBox "A training email was receivied on " & trainingEmail.ReceivedTime & ", however, a department name was not found in the email."
Exit Sub
ExcelProcessingError:
If excelMessage = "" Then
excelMessage = "Excel returned an error while processing the training email. '" & Error(Err) & "'"
End If
On Error Resume Next ' try to close Excel but skip it if it can't
excelWB.Close False
excelApp.Quit
MsgBox excelMessage
End Sub
I hope this at least gets you closer to where you want to be.