Create new column in excel when email received.

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

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.

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:

Attachment 31042Attachment 31043

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:

Code:

---

employeeName = Left(employeeName, InStr(employeeName, vbCr) - 1)


departmentName = Left(departmentName, InStr(departmentName, vbCr) - 1)

---

I'm using the carriage return character.

Code:

---

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.

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:

Code:

---

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.

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.

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