VBA Help - Excel and Outlook

[AK_NYC]

I have a macro in Excel to go into a specific Outlook folder. For all emails in that folder I want to copy the sender email address, subject, body, and date into Excel. When I run the code it returns a an error 'Run-time error 438: Object doesnt support this property or method'. Can someone please advise as to why I am getting this error?

The lines that are not working are in red font below:

Option Explicit

Sub EmailText()

Dim objOutlook As Object
Dim Mynamespace As Object
Dim i As Integer
Dim oRow As Integer
Dim abody() As String


Set objOutlook = GetObject(, "Outlook.Application")
Set Mynamespace = objOutlook.GetNamespace("MAPI")

ThisWorkbook.Sheets(1).Activate

ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender"
ThisWorkbook.Sheets(1).Cells(1, 2) = "Date"
ThisWorkbook.Sheets(1).Cells(1, 3) = "Subject"
ThisWorkbook.Sheets(1).Cells(1, 4) = "Body"

oRow = 1


For i = Mynamespace.GetDefaultFolder(olFolderInbox).Folders("Test").Items.Count To 1 Step -1


oRow = oRow + 1
ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
ThisWorkbook.Sheets(1).Cells(oRow, 1) = Mynamespace.GetDefaultFolder(olFolderInbox).Folders("Test").Items.Item(i).SenderEmailAddress
ThisWorkbook.Sheets(1).Cells(oRow, 2) = Mynamespace.GetDefaultFolder(olFolderInbox).Folders("Test").Items.Item(i).ReceivedTime
ThisWorkbook.Sheets(1).Cells(oRow, 3) = Mynamespace.GetDefaultFolder(olFolderInbox).Folders("Test").Items.Item(i).Subject
ThisWorkbook.Sheets(1).Cells(oRow, 4) = Mynamespace.GetDefaultFolder(olFolderInbox).Folders("Test").Items.Item(i).Body



Next i

Set objOutlook = Nothing
Set Mynamespace = Nothing



End Sub


Thanks!

 

[DanteAmor]

Check if this works for you.

Sub GetEmail_1()
'Fuente: http://stackoverflow.com/questions/8322432/using-visual-basic-to-access-subfolder-in-inbox
'fuente: http://www.snb-vba.eu/VBA_Outlook_external_en.html
'fuente: https://support.microsoft.com/en-us/kb/208520
  Dim olApp As Outlook.Application, objNS As Outlook.Namespace
  Dim olFolder As Outlook.MAPIFolder, MyItems As Outlook.Items
  Dim msg As Outlook.MailItem, i As Long
  '
  Application.ScreenUpdating = False
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set olFolder = objNS.Folders("Test")
  Set MyItems = olFolder.Items
  
  Sheets(1).Select
  Columns("A:D").Clear
  Range("A1:D1") = Array("Sender", "Date", "Subject", "Body")

  On Error Resume Next
  For i = 1 To olFolder.Items.Count
    Cells(i + 1, "A") = MyItems(i).SenderName
    Cells(i + 1, "B") = MyItems(i).ReceivedTime
    Cells(i + 1, "C") = MyItems(i).Subject
    Cells(i + 1, "D") = MyItems(i).body
  Next
  Range("A:D").WrapText = False
  Range("A:D").EntireColumn.AutoFit
End Sub

 

[AK_NYC]

Thank you for this! I just tried to run it and got the following error:
'Run-time error '-2147221233 (8004010f)':
The attempted operation failed. An object could not be found.

This error occured on the below line:
Set olFolder = objNS.Folders("Test")

'Test' is a sub-folder in my main 'Inbox' folder, screenshot is below:

 

[AK_NYC]

I updated the line of code to the below which seems to work:
Application.ScreenUpdating = False
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("Test")
Set MyItems = olFolder.Items

I also updated the below line since I want to retrieve the email address, not the name:
Cells(i + 1, "A") = MyItems(i).SenderEmailAddress
In the Test folder I have 3 emails (1 is internal Outlook email, 1 is from Gmail, 1 is from an external outlook email), when I run the macro now its only returning the Date and Subject from the Gmail and External emails. For the internal Outlook email its only returning the Subject.

Thanks!

 

[DanteAmor]

I guess it's something from the office versions, the following works for me:

Sub GetEmail_1()
'Fuente: http://stackoverflow.com/questions/8322432/using-visual-basic-to-access-subfolder-in-inbox
'fuente: http://www.snb-vba.eu/VBA_Outlook_external_en.html
'fuente: https://support.microsoft.com/en-us/kb/208520
  Dim olApp As Outlook.Application, objNS As Outlook.Namespace
  Dim olFolder As Outlook.MAPIFolder, MyItems As Outlook.Items
  Dim subfolder As Outlook.MAPIFolder
  Dim msg As Outlook.MailItem, i As Long
  '
  Application.ScreenUpdating = False
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set olFolder = objNS.Folders(olFolderInbox)
  Set subfolder = olFolder.Folders("test")
  Set MyItems = subfolder.Items
  
  Sheets(1).Select
  Columns("A:D").Clear
  Range("A1:D1") = Array("Sender", "Date", "Subject", "Body")

  On Error Resume Next
  For i = 1 To subfolder.Items.Count
    Cells(i + 1, "A") = MyItems(i).SenderName
    Cells(i + 1, "B") = MyItems(i).ReceivedTime
    Cells(i + 1, "C") = MyItems(i).Subject
    Cells(i + 1, "D") = MyItems(i).body
  Next
  Range("A:D").WrapText = False
  Range("A:D").EntireColumn.AutoFit
End Sub

 

[AK_NYC]

Thank you, it is still not working properly for me. Its only returning the Date and Subject from the Gmail and External emails, for the internal Outlook email its only returning the Subject. Do you know what setting I need to check regarding Office versions for this to work?

Very frustrating that this works properly on my personal computer but these issues are happening on my work computer.

 

[jerome1503]

Hi, in order to solve this situation, i suggest to modify @DanteAmor suggestion.

remove

Dim subfolder As Outlook.MAPIFolder
...  
Set subfolder = olFolder.Folders("test")
  Set MyItems = subfolder.Items

and insert this :

  Set olfolder = objNS.GetDefaultFolder(olFolderInbox).Folders("test")
  Set MyItems = olfolder.Items

This work for me
Yours,