Solved

Related post to get email data to excel.

Posted on 2010-09-18
11
241 Views
Last Modified: 2012-05-10
Hi,

Related post to get email data to excel.
the below macro works perfect for a type of emails.  
Only issue is the name in colum "H" and "G" workflow data is missing for all.

regards
sharath
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
Comment
Question by:bsharath
  • 6
  • 5
11 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Doesn't look as though the modified code in the original question was working right at all, (columns G/H) but hopefully this is an improvement.

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(ln, "=") > 0 Then

                    workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")

                End If

                If InStr(ln, "(") > 0 And InStr(ln, ",") > 0 Then

                    strTemp = Split(ln, ",")(1)

                    Name = Trim(Split(strTemp, "(")(0)) & " "

                End If

                If InStr(ln, "=") > 0 And InStr(ln, ",") > 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
Comment Utility
Much better. Just a few are missing. sent that to you
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Data supplied like:

Incident Id     : 9876543
Raised User     : Fred Smith
Summary         :  reliever
Details         :  The person noted is leaving the company. Please initiate the collection of assigned company property.

Employee:  A S, Jones  (IN123456)
Job Title:  Actor
Leave date:  01/01/2010
Office location:  Television House
Manager:  Lew Grade
Date            :  1/12/2010 09:00:01 [GMT Daylight Time (GMT+01:00)]

Modification as below.

Chris
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Chris sorry but the data posted by you with names need to be removed. can you please remove or shall i post a removal request..
it has some official name...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
I'll make the request ... I thought i'd changed evrything I sincerely apologise.

Chris
0
Complete Microsoft Windows PC® & Mac Backup

Backup and recovery solutions to protect all your PCs & Mac– on-premises or in remote locations. Acronis backs up entire PC or Mac with patented reliable disk imaging technology and you will be able to restore workstations to a new, dissimilar hardware in minutes.

 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Just realised you said delete all, but in order to maintain the integrity of the site I am aware that the admins require dat to be present.  In cases where data is exchanged outside of EE as in this case they do expect the experts to ensure the flow of data is available to any viewer.

For this reason I requested an edit to remove the relevant data rather than deletion.  i.e. were it to be deleted the question would not be clear to others and would not be in accordance with site rules meaning it would have to be deleted.

I hope I communicated the right data - if not it's probably best you make the request as I again think I have addressed everthing.

Chris
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Thanks Chris now all fine.
Can you post the final code you gave me. That worked perfect for me in all areas...
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
Comment Utility
Oops - I thought I had posted it!

See if it meets the need as below.

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(ln, "=") > 0 Then

                    workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")

                End If

                If InStr(ln, "(") > 0 And InStr(ln, ",") > 0 Then

                    strTemp = Split(ln, ",")(1)

                    Name = Trim(Split(strTemp, "(")(0)) & " "

                End If

                If InStr(ln, "=") > 0 And InStr(ln, ",") > 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)

            ElseIf LCase(ln) Like "employee*" Then

                If InStr(ln, "(") > 0 Then

                    If workflowID = "" Then workflowID = Trim(Replace(Replace(Trim(Split(ln, "(")(1)), ")", ""), "IN", ""))

                End If

                If InStr(ln, "(") > 0 And InStr(ln, ",") > 0 Then

                    strTemp = Split(ln, ",")(1)

                    Name = Trim(Split(strTemp, "(")(0)) & " "

                End If

                If InStr(ln, ",") > 0 Then

                    strTemp = Split(ln, ",")(0)

                    Name = Name & Split(strTemp, ":")(UBound(Split(strTemp, ":")))

                End If

            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
Comment Utility
Thanks a lot Chris works perfect
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Disable Email Signatures via GPO 25 57
Outlook for Mac Meeting Rooms 2 23
outlook 2013 3 23
IMAP folders 4 29
Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

762 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

10 Experts available now in Live!

Get 1:1 Help Now