Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88030

Exporting data from outlook to excel with parsing

$
0
0

I receive a form in email that looks as follows.

The submitted details are below:

Region Europe
Country Spain
Contactable by email no
Contactable by phone no
Title MR
First name John
Last name Doe
Email j.doe@doe.com
Contact number 1234567
Role Customer
Institution companyname ltd
Product TEST product
Message 
TEST Question 

I need to extract some of the fields into the Excel Workbook.

I have been entering those emails manually so I need to find a code to extract data into next empty row.

My Excel headers look like this

Excel columns

enter image description here

I have checked some of the answers here and I managed to put together a code but it doesn't seem to work as needed.

Here what I have so far.

I entered it into Outlook VBA module.

Sub Extract()

    Dim myOlApp As Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim topOlFolder As Outlook.MAPIFolder
    Dim myOlFolder As Outlook.Folder
    Dim myOlMailItem As Outlook.MailItem

    Set myNameSpace = Outlook.Application.GetNamespace("mapi")
    Set objItem = objApp.ActiveExplorer.Selection.Item(1)

    Dim xlObj As worksheet
    Set xlObj = ActiveSheet                          

    Dim anchor As Range
    Set anchor = xlObj.Range("b2")                   

        anchor.Offset(0, 0).Value = "Country"          
    anchor.Offset(0, 1).Value = "Role"         
    anchor.Offset(0, 2).Value = "Product"
    anchor.Offset(0, 3).Value = "Message"
    anchor.Offset(0, 4).Value = "Sender"


    Dim msgText As String
    Dim msgLine() As String
    Dim messageArray() As String

    i = 0                                            
    For Each myOlMailItem In myOlFolder.Items
        i = i + 1                                    

        msgText = myOlMailItem.Body                  

        messageArray = Split(msgText, vbCrLf)       

        For j = 0 To UBound(messageArray)

            msgLine = Split(messageArray(j) & ":", ":")  

            Select Case Left(msgLine(0), 6)              

                Case "Countr"
                    anchor.Offset(i, 0).Value = msgLine(1)             

                Case "Role"
                    anchor.Offset(i, 1).Value = messageArray(j + 1)   

                Case "Product"
                    anchor.Offset(i, 2).Value = messageArray(j + 1)    

                Case "Message"
                    anchor.Offset(i, 3).Value = msgLine(1)             

            End Select
            anchor.Offset(i, 4).Value = myOlMailItem.SenderName
            anchor.Offset(i, -1).Value = i                             

        Next
    Next
End Sub

I would really appreciate your help and comments.

Edit:

I have run the diagnostics tool and this is how email body looks like:

‹crlf›|   
    |‹8 s›<span></span></span></p>‹crlf›|
    |‹8 s›</td>‹crlf›|'
    |‹7 s›</tr>‹crlf›|'
    |‹7 s›<tr>‹crlf›|
    |‹8 s›<td style="padding:0cm 0cm 11.25pt" valign="top">‹crlf›|
    |‹8 s›<p class="MsoNormal" style="margin:0cm 0cm 0.0001pt;font-size:11pt;font-family:&quot;Calibri&qu|
    |ot;,&quot;sans-serif&quot;"><span style="font-size:10.5pt;font-family:&quot;Arial&quot;,&quot;sans-s|
    |erif&quot;">Product‹crlf›|
    |‹8 s›<span></span></span></p>‹crlf›|
    |‹8 s›</td>‹crlf›|
    |‹8 s›<td style="padding:0cm 0cm 11.25pt" valign="top">‹crlf›|
    |‹8 s›<p class="MsoNormal" style="margin:0cm 0cm 0.0001pt;font-size:11pt;font-family:&quot;Calibri&qu|
    |ot;,&quot;sans-serif&quot;"><span style="font-size:10.5pt;font-family:&quot;Arial&quot;,&quot;sans-s|
    |erif&quot;">TEST‹crlf›|
    |‹8 s›product <span></span></span></p>‹crlf›|
    |‹8 s›</td>‹crlf›|
    |‹7 s›</tr>‹crlf›|
    |‹7 s›<tr>‹crlf›|
    |‹8 s›<td colspan="2" style="padding:0cm 0cm 11.25pt" valign="top">‹crlf›|
    |‹8 s›<p class="MsoNormal" style="margin:0cm 0cm 0.0001pt;font-size:11pt;font-family:&quot;Calibri&qu|
    |ot;,&quot;sans-serif&quot;"><span style="font-size:10.5pt;font-family:&quot;Arial&quot;,&quot;sans-s|
    |erif&quot;">

Viewing all articles
Browse latest Browse all 88030

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>