Solved

Related post to get email data to excel.

Posted on 2010-09-18
11
248 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
Office 365 Advanced Training for Admins

Special Offer:  Buy 1 course, get 2nd free!  Buy the 'Managing Office 365 Identities & Requirements' course w/ Accelerated TestPrep, and automatically receive the 'Enabling Office 365 Services' course FREE!

 
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

Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

Question has a verified solution.

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

Having trouble getting your hands on Dynamics 365 Field Service or Project Service trial? Worry No More!!!
My attempt to use PowerShell and other great resources found online to simplify the deployment of Office 365 ProPlus client components to any workstation that needs it, regardless of existing Office components that may be needing attention.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
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…

740 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