get body email into excel

auto

Board Regular
Joined
May 20, 2012
Messages
53
hi, i am trying already weeks getting this done, but with no succses can any one help me with this?

what i have is this,
i am getting emails from sample@example.com in the body of the email, it looks like this,

new customer
customer name: john smith
customer phone: 123-456-7890
customer ID: 123-444444

i am having an excel sheet named test.xlsx in sheet1 i am having on colmn A each customer ID
what i need is, each time i receive an email from sample@example.com then it should look into the body of the email and get me the customer id into my excel sheet automaticly, i tried to write a VBA but i am having lots of errors, i am going to share it here and maybe some1 can help me with a solution.

problem 1) this email works only if i had selected that specific email, what i need is that it should detect by itsel which email needs to be extracted.
problem 2) it shuts down my excel sheet, when i need that up all the time, so how can i run that macro and it should not have to reopen that excel or shutdown?

here is my code
Option Explicit

Sub CopyToExcel()
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim olItem As Outlook.MailItem
Dim vText As Variant
Dim sText As String
Dim vItem As Variant
Dim oRng As Range
Dim i As Long
Dim rCount As Long
Dim bXStarted As Boolean
Const strPath As String = "C:\Users\xxx\Desktop\Test.xlsx" 'the path of the workbook

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

For Each olMail In Fldr.Items
If InStr(olMail.Body, "new customer!") > 0 Then
MsgBox "No Items selected!", vbCritical, "Error"
Exit Sub
End If
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")

For Each olItem In Application.ActiveExplorer.Selection
sText = olItem.Body
vText = Split(sText, Chr(13))
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
rCount = rCount + 1

'Check each line of text in the message body
For i = UBound(vText) To 0 Step -1
If InStr(1, vText(i), "customer ID:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("A" & rCount) = Trim(vItem(1))
End If


Next i
xlWB.Save
xlWB.Close SaveChanges:=True
If bXStarted Then
xlApp.Quit
End If
Next olItem

Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set olItem = Nothing

Next olMail

Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Watch MrExcel Video

Forum statistics

Threads
1,122,469
Messages
5,596,322
Members
414,053
Latest member
Dual Showman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top