• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 239
  • Last Modified:

Need to get all the details in the mail to an excel with a macro in row wise

Hi,

I send a mail to a vendor.for any printer problems that i have.Now as the mails have reched 100's it becomes difficult to see all.
I have the mail content like this.
=========================
Hi ,
                   
                   The  below  mentioned   printer  having the problem .The printout is coming with black patches .So please do the needful   as soon as possible..

Details:

printer model                --  Kyocera FS-3800            
printer s.no                   --  AFT44007867419            
customer name            --  (SB-3F)        
problem type                --  Black Pages
contact person name   -- SHarath.
contact number            -- 3073186349345234

Regards,
Sharath
=================================

So need all data to row wise in a excel sheet.

Any help...

Regards
Sharath
0
bsharath
Asked:
bsharath
  • 9
  • 4
1 Solution
 
David LeeCommented:
Hi, bsharath.

That's easy enough to do if those lines are consistent (that is, if the always have the same format).  Do they?
0
 
bsharathAuthor Commented:
This content is going to be same

printer model                --  Kyocera FS-3800            
printer s.no                   --  AFT44007867419            
customer name            --  (SB-3F)        
problem type                --  Black Pages
contact person name   -- SHarath.
contact number            -- 3073186349345234

Some time some extra fields...
If the mail has extra fields then create a new sheet and place them there...Or put it in the same sheet so that i can sort them later
0
 
bsharathAuthor Commented:
Any help...
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
David LeeCommented:
Sorry to be so slow.  This should do it.  Select as many messages as you want, so long as they all match the pattern you gave, and run the macro.  It'll process all of them and put them into an Excel spreadsheet, one row per message.




Sub ParseMessage()
    Dim olkMessage As Outlook.MailItem, _
        arrLines As Variant, _
        varLine As Variant, _
        arrLine As Variant, _
        varKey As Variant, _
        excApp As Object, _
        excBook As Object, _
        excSheet As Object, _
        intIndex As Integer
    Set excApp = CreateObject("Excel.Application")
    Set excBook = excApp.Workbooks.Add()
    Set excSheet = excBook.Sheets(1)
    intIndex = 1
    For Each olkMessage In Application.ActiveExplorer.Selection
        arrLines = Split(olkMessage.Body, vbCrLf)
        For Each varLine In arrLines
            arrLine = Split(varLine, "--")
            If UBound(arrLine) = 1 Then
                varKey = Replace(arrLine(0), Chr(160), "")
                varKey = Trim(varKey)
                Select Case varKey
                    Case "printer model"
                        excSheet.Cells(intIndex, 1) = arrLine(1)
                    Case "printer s.no"
                        excSheet.Cells(intIndex, 2) = arrLine(1)
                    Case "customer name"
                        excSheet.Cells(intIndex, 3) = arrLine(1)
                    Case "problem type"
                        excSheet.Cells(intIndex, 4) = arrLine(1)
                    Case "contact person name"
                        excSheet.Cells(intIndex, 5) = arrLine(1)
                    Case "contact number"
                        excSheet.Cells(intIndex, 6) = Chr(34) & arrLine(1) & Chr(34)
                End Select
            End If
        Next
        intIndex = intIndex + 1
    Next
    'Change the path/filename on the following line as needed
    excBook.SaveAs "C:\eeTesting\BSharath.xls"
    excBook.Close
    Set excSheet = Nothing
    Set excBook = Nothing
    Set excApp = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

0
 
bsharathAuthor Commented:
Thanks a lot Can i get the headers also.
Is it possible to find which is left out on the selected mails if any.In sheet 2.Because of header mismatch.
0
 
bsharathAuthor Commented:
Sorry for another addition.I need to get the Mail sent date also to the excel.Only then the whole file is ready.
0
 
bsharathAuthor Commented:
A little more help please...
0
 
David LeeCommented:
Where do you want the date to go, the begining, the end, somewhere in the middle?
0
 
bsharathAuthor Commented:
The begining....
0
 
David LeeCommented:
Try this.
Sub ParseMessage()
    Dim olkMessage As Outlook.MailItem, _
        arrLines As Variant, _
        varLine As Variant, _
        arrLine As Variant, _
        varKey As Variant, _
        excApp As Object, _
        excBook As Object, _
        excSheet As Object, _
        intIndex As Integer
    Set excApp = CreateObject("Excel.Application")
    Set excBook = excApp.Workbooks.Add()
    Set excSheet = excBook.Sheets(1)
    intIndex = 1
    For Each olkMessage In Application.ActiveExplorer.Selection
        excSheet.Cells(intIndex, 1) = olkMessage.ReceivedTime
        arrLines = Split(olkMessage.Body, vbCrLf)
        For Each varLine In arrLines
            arrLine = Split(varLine, "--")
            If UBound(arrLine) = 1 Then
                varKey = Replace(arrLine(0), Chr(160), "")
                varKey = Trim(varKey)
                Select Case varKey
                    Case "printer model"
                        excSheet.Cells(intIndex, 2) = arrLine(1)
                    Case "printer s.no"
                        excSheet.Cells(intIndex, 3) = arrLine(1)
                    Case "customer name"
                        excSheet.Cells(intIndex, 4) = arrLine(1)
                    Case "problem type"
                        excSheet.Cells(intIndex, 5) = arrLine(1)
                    Case "contact person name"
                        excSheet.Cells(intIndex, 6) = arrLine(1)
                    Case "contact number"
                        excSheet.Cells(intIndex, 7) = Chr(34) & arrLine(1) & Chr(34)
                End Select
            End If
        Next
        intIndex = intIndex + 1
    Next
    'Change the path/filename on the following line as needed
    excBook.SaveAs "C:\eeTesting\BSharath.xls"
    excBook.Close
    Set excSheet = Nothing
    Set excBook = Nothing
    Set excApp = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

0
 
bsharathAuthor Commented:
Thanks a lot....For this excellent help....
0
 
bsharathAuthor Commented:
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 9
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now