Solved

Outlook macro to copy arrived emails body into excel files.

Posted on 2010-09-16
15
929 Views
Last Modified: 2012-05-10
Hi,

Need an outlook script to save mails with this subject "Task has been assigned to you for the Incident ID 89859"
The only change between these subjects would be the ID at the end. Remaing would be same.

When mail arrives the data within the mail would be as this

Incident Id        :  89859
Raised User       :  Vajan
Summary          :  Leaver - service request: IN - Raj, Anu (WorkflowID = 8940489)
Details                 :  Nt id and email to be disabled
System to be taken back tp stock
Date                 :  14/09/2010 16:28:31 [GMT Daylight Time (GMT+01:00)]


It has to save each mail into an excel as the attached format.After it has done it has to popup a box stating new data copied. Each day i receive from 1 email to 20. So only once i need to get the popup.

Can we schedule a time? if thats difficult. Then that part i will check manually.

regards
Sharath
Outlook-to-excel.xls
0
Comment
Question by:bsharath
  • 8
  • 7
15 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33703550
An outlook macro to implement the code is as follows.  Easiest way to call is create a rule triggered by subject like
"Task has been assigned to you for the Incident ID "

(i.e. with specific words in the subject).

Call the script Q26477149 in such cases and then having edited the file name/location from
C:\Users\Chris\Experts Exchange\Outlook-to-excel.xls
to your own needs it should write the data out ... but from my perspective that's enough for one question assuming it works.

Chris
Sub Q26477149(mai As MailItem)
Dim dateRecd As String
Dim id As String
Dim raised As String
Dim summary As String
Dim details As String
Dim dateDue As String
Dim workflowID As String
Dim Name As String
Dim ln As Variant
Dim strTemp As String
Dim xlApp As Object
Dim rw As Long
Const xlup As Integer = -4162

    dateRecd = Format(mai.ReceivedTime, "ddd dd/mm/yyyy")
'    id = getDatabyRegEx(mai.body, "(Incident Id[ \xA0]+?:[ \xA0]+)([0-9]{1,})")
'    raised = getDatabyRegEx(mai.body, "(Raised User[ \xA0]+?:[ \xA0]+)([\w\s]{1,}[\r\n])")
'    summary = getDatabyRegEx(mai.body, "(Summary[ \xA0]+?:[ \xA0]+)(.*)[\r\n]")
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
        If LCase(ln) Like "incident id*" Then
            id = Trim(Split(ln, ":")(1))
        ElseIf LCase(ln) Like "raised user*" Then
            raised = Trim(Split(ln, ":")(1))
        ElseIf LCase(ln) Like "summary*" Then
            summary = Trim(Split(ln, ":")(1))
            workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")
            strTemp = Split(ln, ",")(1)
            Name = Trim(Split(strTemp, "(")(0)) & " "
            strTemp = Split(ln, ",")(0)
            Name = Name & Split(strTemp, "-")(UBound(Split(strTemp, "-")))
        ElseIf LCase(ln) Like "details*" Then
            details = Trim(Split(ln, ":")(1))
        ElseIf LCase(ln) Like "date*" Then
            dateDue = Split(Trim(Split(ln, ":")(1)), " ")(0)
        End If
    Next
    Set xlApp = CreateObject("excel.application")
    With xlApp.workbooks.Open("C:\Users\Chris\Experts Exchange\Outlook-to-excel.xls")
        rw = .sheets(1).Range("A" & .sheets(1).Rows.count).End(xlup).Row + 1
        .sheets(1).Range("A" & rw) = dateRecd
        .sheets(1).Range("B" & rw) = id
        .sheets(1).Range("C" & rw) = raised
        .sheets(1).Range("D" & rw) = summary
        .sheets(1).Range("E" & rw) = details
        .sheets(1).Range("F" & rw) = dateDue
        .sheets(1).Range("G" & rw) = workflowID
        .sheets(1).Range("H" & rw) = Name
        .Close True
    End With
    xlApp.Quit
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33703677
Thanks Chris works perfect. one q here
How can i run this on a folder which has mails already in them
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33703961
Something for example like the following which assumes you have selected the folder first.

Chris
Sub catchup()
Dim itm As Object

    For Each itm In Application.ActiveExplorer.CurrentFolder.items
        If itm.Class = olMail Then Q26477149 itm
    Next
End Sub

Open in new window

0
The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

 
LVL 11

Author Comment

by:bsharath
ID: 33704076
I get subscript out of range
When debug goes here
            details = Trim(Split(ln, ":")(1))

This folder will have other emails also
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33704121
I would imagine the email does not follow the standards set out in your original question ... i.e. no :

The catchup script as supplied ensures only emails are passed to the sub so that's a non issue hopefully.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33704144
The following amendment skips a line if the colon is missing.

Chris
Sub Q26477149(mai As MailItem)
Dim dateRecd As String
Dim id As String
Dim raised As String
Dim summary As String
Dim details As String
Dim dateDue As String
Dim workflowID As String
Dim Name As String
Dim ln As Variant
Dim strTemp As String
Dim xlApp As Object
Dim rw As Long
Const xlup As Integer = -4162

    dateRecd = Format(mai.ReceivedTime, "ddd dd/mm/yyyy")
'    id = getDatabyRegEx(mai.body, "(Incident Id[ \xA0]+?:[ \xA0]+)([0-9]{1,})")
'    raised = getDatabyRegEx(mai.body, "(Raised User[ \xA0]+?:[ \xA0]+)([\w\s]{1,}[\r\n])")
'    summary = getDatabyRegEx(mai.body, "(Summary[ \xA0]+?:[ \xA0]+)(.*)[\r\n]")
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
        If InStr(ln, ":") > 0 Then
            If LCase(ln) Like "incident id*" Then
                id = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "raised user*" Then
                raised = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "summary*" Then
                summary = Trim(Split(ln, ":")(1))
                workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")
                strTemp = Split(ln, ",")(1)
                Name = Trim(Split(strTemp, "(")(0)) & " "
                strTemp = Split(ln, ",")(0)
                Name = Name & Split(strTemp, "-")(UBound(Split(strTemp, "-")))
            ElseIf LCase(ln) Like "details*" Then
                details = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "date*" Then
                dateDue = Split(Trim(Split(ln, ":")(1)), " ")(0)
            End If
        End If
    Next
    Set xlApp = CreateObject("excel.application")
    With xlApp.workbooks.Open("C:\Users\Chris\Experts Exchange\Outlook-to-excel.xls")
        rw = .sheets(1).Range("A" & .sheets(1).Rows.count).End(xlup).Row + 1
        .sheets(1).Range("A" & rw) = dateRecd
        .sheets(1).Range("B" & rw) = id
        .sheets(1).Range("C" & rw) = raised
        .sheets(1).Range("D" & rw) = summary
        .sheets(1).Range("E" & rw) = details
        .sheets(1).Range("F" & rw) = dateDue
        .sheets(1).Range("G" & rw) = workflowID
        .sheets(1).Range("H" & rw) = Name
        .Close True
    End With
    xlApp.Quit
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33707225
Chris if any one of the fields are missing in the email. Can we skip them and go to next.
Skip i mean just the field and not the email
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33707306
That's how it's coded already:

    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
        If InStr(ln, ":") > 0 Then
            If LCase(ln) Like "incident id*" Then
'etc
            End If
        End If
    Next

ie for each email, check if the line contains a colon and if it doesn't then skip the line and check the next line in the same email ... the implementation uses the colon from the original specification to differentiate between data and label.

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 33707371
Why i asked is i get subscript out of range
When debug goes here
                workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33707449
Try this then ... it adds additional checks for the other data formatting.

Chris
Sub Q26477149(mai As MailItem)
Dim dateRecd As String
Dim id As String
Dim raised As String
Dim summary As String
Dim details As String
Dim dateDue As String
Dim workflowID As String
Dim Name As String
Dim ln As Variant
Dim strTemp As String
Dim xlApp As Object
Dim rw As Long
Const xlup As Integer = -4162

    dateRecd = Format(mai.ReceivedTime, "ddd dd/mm/yyyy")
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
        If InStr(ln, ":") > 0 Then
            If LCase(ln) Like "incident id*" Then
                id = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "raised user*" Then
                raised = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "summary*" Then
                summary = Trim(Split(ln, ":")(1))
                if instr(strtemp, "=") > 0 then
                    workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")
                end if
                strTemp = Split(ln, ",")(1)
                if instr(strtemp, "(") > 0 then
                    Name = Trim(Split(strTemp, "(")(0)) & " "
                end if
                strTemp = Split(ln, ",")(0)
                if instr(strtemp, "=") > 0 then
                    Name = Name & Split(strTemp, "-")(UBound(Split(strTemp, "-")))
                end if
            ElseIf LCase(ln) Like "details*" Then
                details = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "date*" Then
                dateDue = Split(Trim(Split(ln, ":")(1)), " ")(0)
            End If
        End If
    Next
    Set xlApp = CreateObject("excel.application")
    With xlApp.workbooks.Open("C:\Users\Chris\Experts Exchange\Outlook-to-excel.xls")
        rw = .sheets(1).Range("A" & .sheets(1).Rows.count).End(xlup).Row + 1
        .sheets(1).Range("A" & rw) = dateRecd
        .sheets(1).Range("B" & rw) = id
        .sheets(1).Range("C" & rw) = raised
        .sheets(1).Range("D" & rw) = summary
        .sheets(1).Range("E" & rw) = details
        .sheets(1).Range("F" & rw) = dateDue
        .sheets(1).Range("G" & rw) = workflowID
        .sheets(1).Range("H" & rw) = Name
        .Close True
    End With
    xlApp.Quit
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33707468
I get subscript out of range in this line

                strTemp = Split(ln, ",")(1)
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 33707578
Oops.  Further refined

Chris
Sub Q26477149(mai As MailItem)
Dim dateRecd As String
Dim id As String
Dim raised As String
Dim summary As String
Dim details As String
Dim dateDue As String
Dim workflowID As String
Dim Name As String
Dim ln As Variant
Dim strTemp As String
Dim xlApp As Object
Dim rw As Long
Const xlup As Integer = -4162

    If InStr(mai.body, vbCrLf) = 0 Then Exit Sub
    dateRecd = Format(mai.ReceivedTime, "ddd dd/mm/yyyy")
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
        If InStr(ln, ":") > 0 Then
            If LCase(ln) Like "incident id*" Then
                id = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "raised user*" Then
                raised = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "summary*" Then
                summary = Trim(Split(ln, ":")(1))
                If InStr(strTemp, "=") > 0 Then
                    workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")
                End If
                If InStr(strTemp, "(") > 0 And InStr(strTemp, ",") > 0 Then
                    strTemp = Split(ln, ",")(1)
                    Name = Trim(Split(strTemp, "(")(0)) & " "
                End If
                If InStr(strTemp, "=") > 0 And InStr(strTemp, ",") > 0 Then
                    strTemp = Split(ln, ",")(0)
                    Name = Name & Split(strTemp, "-")(UBound(Split(strTemp, "-")))
                End If
            ElseIf LCase(ln) Like "details*" Then
                details = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "date*" Then
                dateDue = Split(Trim(Split(ln, ":")(1)), " ")(0)
            End If
        End If
    Next
    Set xlApp = CreateObject("excel.application")
    With xlApp.workbooks.Open("C:\Users\Chris\Experts Exchange\Outlook-to-excel.xls")
        rw = .sheets(1).Range("A" & .sheets(1).Rows.count).End(xlup).Row + 1
        .sheets(1).Range("A" & rw) = dateRecd
        .sheets(1).Range("B" & rw) = id
        .sheets(1).Range("C" & rw) = raised
        .sheets(1).Range("D" & rw) = summary
        .sheets(1).Range("E" & rw) = details
        .sheets(1).Range("F" & rw) = dateDue
        .sheets(1).Range("G" & rw) = workflowID
        .sheets(1).Range("H" & rw) = Name
        .Close True
    End With
    xlApp.Quit
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 33707900
Chris no errors works fine now.
Only issue is the name in colum "H" and "G" workflow data is missing for all.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33707971
Name and workflow are highly dependant on data formatting ... if it works ok for the original sample and not the others then I suggest the solution is good and that you need it adapting for resilience.

If you were to ask a new question for that then you will need to supply a range of text samples and required outcomes for the name/workflow id so that a potential regular expression based solution can be used to analyse for the data.

Aspects I suspect you need to address in such a data sample are multiple names i.e. first names fred john and lastnames Smith Jones ... i.e. Smith Jones, Fred John

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 33710299
0

Featured Post

The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This process describes the steps required to Import and Export data from and to .pst files using Exchange 2010. We can use these steps to export data from a user to a .pst file, import data back to the same or a different user, or even import data t…
This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…

813 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now