I'm a little out of my depth here, and definitely fumbling my way through trying to do this.

Scenario:

Emails arrive in a shared inbox every day for every new hire into the org. This is the full body of one of those emails:

The following are the new user details:

Full Name: Martha Washington
Employee ID: 123456
Department: Nursing Education and Research
Division: 17
RC: 730216
Job Title: Clin Nurse PRN Dept
Location: Medical Office Bldg West
Username: 12345678

I need to make/modify a script that will take only 3 lines out of this email body, and put them into columns in Excel. I need to get the Username value, the Job Title value, and the Location values and put them into separate columns. Then, the next email that arrives needs the same data extracted and put in a new row in Excel.

I want the Excel file to look something like this:

Any and all help is appreciated!

CodePudding user response：

I have something similar in my outlook application.

So this is Outlook VBA:

Sub Provtagning(msg As Outlook.MailItem)
    Dim RE As Object
    Dim objFolder As Outlook.MAPIFolder
    Dim xExcelFile As String
    Dim xExcelApp As Excel.Application
    Dim wb As Excel.Workbook
    
    ' wait for file to be closed (if multiple mails arrive at the same time)
    While IsWorkBookOpen("Path to file")
        WasteTime (1)
    Wend
    DoEvents
    
    
    Set xExcelApp = CreateObject("Excel.Application")
    Set wb = xExcelApp.Workbooks.Open("Path to file")

    
    Set RE = CreateObject("vbscript.regexp")

    lrow = wb.Sheets("Sheet1").Cells(wb.Sheets("Sheet1").rows.Count, "A").End(xlUp).Row   1
    

    RE.Pattern = "Username:\s(\d )"
    Set allMatches = RE.Execute(msg.Body)
    username = allMatches.Item(0).SubMatches.Item(0)
    
    RE.Pattern = "Job Title:\s([a-zA-Z ] )"
    Set allMatches = RE.Execute(msg.Body)
    title = allMatches.Item(0).SubMatches.Item(0)

    RE.Pattern = "Location:\s([a-zA-Z ] )"
    Set allMatches = RE.Execute(msg.Body)
    location = allMatches.Item(0).SubMatches.Item(0)    

    wb.Sheets("Sheet1").Range("A" & lrow).Value = username
    wb.Sheets("Sheet1").Range("B" & lrow).Value = title
    wb.Sheets("Sheet1").Range("C" & lrow).Value = location

    wb.Save
    wb.Close
End Sub

Sub WasteTime(Finish As Long)
 
    Dim NowTick As Long
    Dim EndTick As Long
 
    EndTick = GetTickCount   (Finish * 1000)
     
    Do
 
        NowTick = GetTickCount
        DoEvents
 
    Loop Until NowTick >= EndTick
 
End Sub

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

You may need to adjust the regex patterns if there is something that is different.

Then just create a rule in Outlook to run this script on every email that is from SomeEmail or whatever that is the trigger.

CodePudding user response：

The Outlook object model provides the NewMailEx event of the Application class which is fired when a new message arrives in the Inbox and before client rule processing occurs. Use the Entry ID represented by the EntryIDCollection string to call the NameSpace.GetItemFromID method and process the item. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. So, in the NewMailEx event you can get an instance of the incoming email where you could extract all the required information from the message body.

The Outlook object model provides three main ways for working with item bodies:

1. Body.
2. HTMLBody.
3. The Word editor. The WordEditor property of the Inspector class returns an instance of the Word Document which represents the message body.

See Chapter 17: Working with Item Bodies for more information.