?
Solved

Related post to get email data to excel.

Posted on 2010-09-18
11
Medium Priority
?
257 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Visualize your virtual and backup environments

Create well-organized and polished visualizations of your virtual and backup environments when planning VMware vSphere, Microsoft Hyper-V or Veeam deployments. It helps you to gain better visibility and valuable business insights.

 
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 2000 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

Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

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

Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing how…
This article describes how to import Lotus Notes Contacts into Outlook 2016, 2013, 2010 and 2007 etc. with a few manual steps. You can easily export and migrate Lotus Notes contacts into Microsoft Outlook without having to use any third party tools.
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
Suggested Courses

770 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