Hello All,
I am looking for help for the below VBA code which I am trying to put Excel to copy & paste the body of the selected mails from outlook to excel spreadsheet. I am getting an error message at line no. 27 as "Application Defined or Object Defined error". I want to VB code to copy body of the message in different rows, but what does the below code is doing is putting the entire body of the message in one single cell. This caused me an error of limitation of data type. Your valuable assistance will be great help for me on this. Thanks in advance.
I am looking for help for the below VBA code which I am trying to put Excel to copy & paste the body of the selected mails from outlook to excel spreadsheet. I am getting an error message at line no. 27 as "Application Defined or Object Defined error". I want to VB code to copy body of the message in different rows, but what does the below code is doing is putting the entire body of the message in one single cell. This caused me an error of limitation of data type. Your valuable assistance will be great help for me on this. Thanks in advance.
- Sub Mailbody_To_Excel()
- 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 mail As MailItem
- Dim vbody As String
- 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 Like "*SubjectLineofmail*" 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("B4").Value = vbody
- xlApp.ActiveWorkbook.SaveAs ("C:\Desktop\DailyReport_" & Format(Date, "MM-DD-YYYY") & ".xls")
- xlWkb.Close
- xlApp.Quit
- Set xlWkb = Nothing
- Set xlApp = Nothing
- End If
- Next
- Set objSearchFolder = Nothing
- Set Inbox = Nothing
- Set ns = Nothing
- End Sub