# vba copy email body to excel



## 7mani09 (Dec 12, 2010)

please help me in writing outlook VBA to open emails from specific sender and copy body to excel and save it under specific name with current date


----------



## Keebellah (Mar 27, 2008)

Hi, welcome tothe board,

Take a look at this post, it'll put you on the right track

http://forums.techguy.org/business-applications/966780-excel-outlook-vba.html


----------



## 7mani09 (Dec 12, 2010)

following is my code but it doesn't work

Sub savedailyownership()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim item As Object
Dim mai As MailItem

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox
i = 0
If Inbox.item.Count = 0 Then
MsgBox "Inbox is Empty", vbInformation, "Nothing Found"
End If
For Each item In Inbox.Items
If item.Subject Like "[Send_ForeignInvestment]" Then
item.Display
item.Body.Select
Selection.Copy
Dim xlApp As Object ' Excel.Application
Dim xlWkb As Object ' Excel.Workbook
Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.Selection.Paste False, False, False
End If
Next
End Sub


----------



## Keebellah (Mar 27, 2008)

I can't make very much of this but let me see if I understand your code:

You check a particular mail folder in Outlook
If the forlder is not empty you open the mail item and select the body text
Then you go and create a new Excel workbook (no name added) and past what is in the clipboard.

Okay, as I see, you forgot a Next item.

You only say Next but Excel likes to know next what


```
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.Selection.Paste False, False, False
End If
Next [B]item[/B]
End Sub

[\code]

Since you don't say what doesn't work and if you get an error message, then you must think how the other party trying to help you needs to 'guess'

It is always good practice to give as much information as is possible when you want somebody to help you
Excel? What version?  etc etc.

Okay enough of this, see if adding the text in red to your code solves the issue, if it doesn't, please give as much information as you can since we have to picture your problem
```


----------



## Rollin_Again (Sep 4, 2003)

Here is the corrected code. You don't need to copy/paste anything since the body text can be set to a variable and then called directly into Excel. The part highlighted in green represents which cell in the Excel workbook that you want the data copied to. The part of the code highlighted in red represent the directory where the file will be saved. Just change it to whatever the correct save path should be. The portion highlighted in blue represents the actual Excel file name that is appended to the date. Note that the date had to be formatted in order to comply with the limited use of special characters in Excel filenames. You may also need to change the the ".xls" extension in the code to the more recent version used by Office 2007 and newer (.xlsx) depending on your specific version. The code assumes that there will be no more that 1 file to process per day or else you will need to add logic to check for an existing file with the same name and take action to save under an alternate non-conflicting name. While Hans' suggestion to add the name after the next statement is good practice it will still run fine without it. Also note that depending on the size of the email body you may or may not be able to fit the contents into a single cell in Excel depending on the individual cell character limit.


```
Sub savedailyownership()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim item As Object
Dim mai As MailItem

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox
i = 0
If Inbox.Items.Count = 0 Then
MsgBox "Inbox is Empty", vbInformation, "Nothing Found"
End If
For Each item In Inbox.Items
If item.Subject Like "[Send_ForeignInvestment]" Then

vBody = item.Body

Dim xlApp As Object ' Excel.Application
Dim xlWkb As Object ' Excel.Workbook
Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
xlApp.Visible = True
Set xlWkb = xlApp.Workbooks.Add


xlApp.[COLOR="Green"]Range("A2").[/COLOR]Value = vBody
xlApp.activeworkbook.SaveAs ("[COLOR="Red"]C:\Test[/COLOR]\[COLOR="Blue"]DailyReport[/COLOR]_" & Format(Date, "MM-DD-YYYY") & [COLOR="Orange"]".xls[/COLOR]")

xlWkb.Close
xlApp.Quit

Set xlWkb = Nothing
Set xlApp = Nothing



End If
Next

Set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing


End Sub
```
Rollin


----------



## 7mani09 (Dec 12, 2010)

thank you all i change the code as per rollen but i still have abroblem 
the data copied only the first 3 lines of the email body
the body of this email contain: title and table
i got only the title and fist 2 row from the table only 
2nd problem it past in one cell 
current code is:
Sub savedailyownership()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim item As Object
Dim mai As MailItem
Dim body

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox
i = 0
If Inbox.Items.Count = 0 Then
MsgBox "Inbox is Empty", vbInformation, "Nothing Found"
End If
If Inbox.Items.Count > 0 Then
End If
For Each item In Inbox.Items
If item.Subject = "[Send_ForeignInvestment]" Then
vBody = item.body
Dim xlApp As Object ' Excel.Application
Dim xlWkb As Object ' Excel.Workbook
Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
xlApp.Visible = True
Set xlWkb = xlApp.Workbooks.Add
xlApp.Range("A2").Value = vBody

End If
Next
Set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing

End Sub


----------



## 7mani09 (Dec 12, 2010)

sorry i forget to mention that im using outlook 2007


----------



## Rollin_Again (Sep 4, 2003)

Can you forward me a couple of the actual emails so that I can do some testing? Rollin_Again at hotmail dot com

Rollin


----------



## 7mani09 (Dec 12, 2010)

following example of the email:
*From:* .................................................
*Sent:* Thursday, December 16, 2010 12:01 AM
*To:* me
*Cc:* .................
*Subject:* [Send_ForeignInvestment]

[Send_ForeignInvestment]
Foreign Investment List
PRODUCTNAMESYMBOLCOUNTRYCITYC.NO.QUI.AVAIO.O.SARRAIVAL TIMEproductnameA1
UK
ZAFA94.305.280.000.422010-12-15T16:05:27.160productnameB3
USA
OAFD100.000.000.000.002010-12-15T16:05:31.630productnameG
ITALY
KKLA4.0193.672.300.022010-12-15T16:05:33.757productnameUF
CHINA
DJHFA99.900.000.000.102010-12-15T16:05:41.973productnameUN
INDIA
KAFN100.000.000.000.002010-12-15T16:05:42.007


----------



## 7mani09 (Dec 12, 2010)

i mean the attached file is an example


----------



## 7mani09 (Dec 12, 2010)

still not find the correct code


----------



## Rollin_Again (Sep 4, 2003)

Can you save the actual email as *.msg* format and forward it to me?

Rollin


----------

