Solved

Related post to get email data to excel.

Posted on 2010-09-18
11
242 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
ID: 33710367
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
ID: 33710434
Much better. Just a few are missing. sent that to you
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33710684
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
ID: 33710697
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
ID: 33710728
I'll make the request ... I thought i'd changed evrything I sincerely apologise.

Chris
0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33710743
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
ID: 33710745
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
ID: 33710757
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
ID: 33710761
Thanks a lot Chris works perfect
0
 
LVL 11

Author Comment

by:bsharath
ID: 33710770
0
 
LVL 11

Author Comment

by:bsharath
ID: 33717036
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Outlook Free & Paid Tools
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…
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.
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…

911 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

20 Experts available now in Live!

Get 1:1 Help Now