Create new column in excel when email received.

[ecalid]

Good afternoon all,

I am wondering if somebody could help me with this, I have tried to piece together some code but I am getting nowhere, I am not familiar with using VBA for outlook.

I am trying to get VBA to create a new column in my excel workbook when an email with a specific subject arrives in the shared mailbox.

The process is explained below:

1. The new email is generated from an existing script which has a pre-determined subject.
2. Inside the email is a department, surname and forename.
3. I need the script to be able to identify from the email; which department the individual pertains. There are 4 departments, so there are 4 separate worksheets.
4. Then create a new column in the departments excel sheet in the workbook with the name from the email.

Is this something that is easy to do?

Please let me know if you could help me with this.


Many thanks,

Ecalid

[June7]

Why would you want to create a new column? This sounds like bad design.

Why are you using Excel as a database?

Creating a new column is fairly simple. Manipulating Outlook can be rather tricky.

[ecalid]

Thanks for your reply.

The new column will represent a new starter in the business; I have built a training matrix in which I manually add new starters when managers submit new starter requests through the portal I've made, but would like this to be automated somewhat.

Unfortunately our company is quite archaic as they do not believe in using catered software, and they are very adverse to me using Power Automate. They create their own in-house applications but what I need is not deemed as a priority for them, so I need to take this upon myself.

I only need it to read the subject of an incoming email and then read the information contained within; the email has a pre-set body so there isn't many variables at all for it to search.

In essence it needs to read one line which says "Department" and then choose the worksheet which corresponds to this.

And then, read the line which says "Employee" and then if it doesn't exist, create a new column and input the name into the preferred cell.

Please see below for the automated email and training matrix:

3104231043

[jdelano]

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) (https://www.slipstick.com/outlook/rules/outlooks-rules-and-alerts-run-a-script/)
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) (https://www.slipstick.com/outlook/rules/outlook-run-a-script-rules/)

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.

[June7]

One step at a time. First figure out how to extract data from email. Common topic.

Then figure out how to create Excel column and save data to cell. This part could be as simple as:



With Worksheets("Sheet1")
.Cells(1, .Cells(1, 1).End(xlToRight).column).Value = strData
End With

A really tricky part is figuring out how to trigger code execution.

Now I see jdelano's post. Hope that helps.

[ecalid]

Thank you so much for this and your kind effort.

Unfortunately I can't get the script to run from the rule.

It brings up the New Mail Alert, but does nothing for the spreadsheet. There are no errors or message boxes as expected.

Not sure what I am doing wrong.

[jdelano]

Can you show a screenshot of the rule configuration and the Visual Basic in Outlook?