Solved

Related post to get email data to excel.

Posted on 2010-09-18
11
243 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
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: 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
 
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

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

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

Are you unable to connect or configure Hotmail email account in Microsoft Outlook 2010, 2007? Or Outlook.com emails are not downloading to Outlook? Lets’ see the problem and resolve Outlook Connector error syncing folder hierarchy (0x8004102A).
Having trouble getting your hands on Dynamics 365 Field Service or Project Service trial? Worry No More!!!
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…

803 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