Error when exporting Sent Mail to Excel

[lneidorf]

Operating system::    Windows 11
Outlook version:     Classic O365 v2401
Email type or host:    O365

---

Hi there.

I have some code designed to loop through my Sent Mail folder and export certain fields to a spreadsheet. It errors out, with an "Object doesn't support this property or method" error. I can tell by the entries on the spreadsheet that it's erroring out when it encounters Calendar Invite acceptances.

My code appears below; I'd be grateful for an assist.

Many thanks!

Option Explicit

Sub List_Email_Info()


Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim i As Integer
Dim arrHeader As Variant
Dim olNS As NameSpace
Dim olInboxFolder As MAPIFolder
Dim olItems As Items
Dim olMailItem As mailItem
Dim dtStart As Date
Dim oItem As Object
Dim oMail As mailItem
Dim txtInputDate As String
Dim dtEmailDate As String
Dim c As Range
Dim firstAddress As String
Dim strCopyToAddress As String
Dim strCopyFromAddress As String
Dim strFormula As String



txtInputDate = "1/01/2024"

arrHeader = Array("PM", "Date", "PID", "SONumber", "Project Name", "Hours", "Billable", "Description Category", "Standard Description", "Description Text")

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add


Set olNS = GetNamespace("MAPI")
''Set olInboxFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olInboxFolder = olNS.GetDefaultFolder(olFolderSentMail)

Set olItems = olInboxFolder.Items


i = 1


On Error GoTo ERRHANDLER:


xlWB.Worksheets(1).Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader


For Each oItem In Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
    If TypeName(oItem) = "MailItem" Then
        Set oMail = oItem
            
            olItems.Sort "[CreationTime]", True
            
            dtEmailDate = Format(olItems(i).CreationTime, "MM-DD-YYYY")
    
            
            If olItems(i).CreationTime >= CDate(txtInputDate) Then
            
          
            'xlWB.Worksheets(1).Cells(i + 1, "A").Value = olItems(i).CreationTime
            xlWB.Worksheets(1).Cells(i + 1, "A").Value = olItems(i).SenderName
            xlWB.Worksheets(1).Cells(i + 1, "B").Value = Format(olItems(i).CreationTime, "MM-DD-YYYY")
            xlWB.Worksheets(1).Cells(i + 1, "C").Value = ""
            xlWB.Worksheets(1).Cells(i + 1, "D").Value = ""
            xlWB.Worksheets(1).Cells(i + 1, "E").Value = olItems(i).TaskSubject
            xlWB.Worksheets(1).Cells(i + 1, "F").Value = ""
            xlWB.Worksheets(1).Cells(i + 1, "G").Value = ""
            xlWB.Worksheets(1).Cells(i + 1, "H").Value = "Review"
            xlWB.Worksheets(1).Cells(i + 1, "I").Value = "Other"
            xlWB.Worksheets(1).Cells(i + 1, "J").Value = olItems(i).TaskSubject
            '''xlWB.Worksheets(1).Cells(i + 1, "D").Value = olItems(i).ReceivedTime
            
            End If
            
            i = i + 1
        
    End If
    
Next oItem

''Find last number of column
Range("D" & Rows.Count).End(xlUp).Offset(1).Select

'''Range("D1:D2").Select
'''Selection.AutoFill Destination:=Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
'''Range(Selection, Selection.End(xlDown)).Select


''MsgBox ActiveCell.Address
strCopyToAddress = ActiveCell.Address

Range("D2").Value = "=MID(E2,FIND(75,E2,1),7)"
strFormula = Range("D2").Formula
''strCopyFromAddress = "=MID(E2,FIND(75,E2,1),7)"-+

Range("D2").Select

''MsgBox ActiveCell.Formula

Range("D2").Copy

''Range("D3").Select
Range("D3" & ":" & strCopyToAddress & "").Select
ActiveSheet.Paste

xlWB.Worksheets(1).Cells.EntireColumn.AutoFit

MsgBox "Export complete."

Set xlWB = Nothing
Set xlApp = Nothing

Set olItems = Nothing
Set olInboxFolder = Nothing
Set olNS = Nothing

ERRHANDLER:
If Err.Number <> 0 Then
    MsgBox Err.Description, Err.Number
    Debug.Print Err.Description, Err.Number
Else
    Exit Sub
End If   
Exit Sub
End Sub

 

[Diane Poremsky]

>> If TypeName(oItem) = "MailItem" Then

That should kick it out. Try If TypeName(oItem) <> "MailItem" Then goto netxmsg to jump out of the loop.

Or use messageclass instead:

if oItem.messageclass ="ipm.note" then

 

[lneidorf]

>> If TypeName(oItem) = "MailItem" Then

That should kick it out. Try If TypeName(oItem) <> "MailItem" Then goto netxmsg to jump out of the loop.

Or use messageclass instead:

if oItem.messageclass ="ipm.note" then

Many thanks, Diane.

I'm a VBA novice, so I'm not sure where to put this. I assume I substitute it for:

If TypeName(oItem) = "MailItem" Then

I tried that and no dice. Assuming I need some sort of "Else IF" statement.

Thanks!

 

[Diane Poremsky]

This
if oItem.messageclass ="ipm.note" then

would replace

If TypeName(oItem) = "MailItem" Then

Did it error or just not work?


Or... change the dim 's from mailitem to object - that should work with any items as long as it has the fields you need.
Dim olMailItem As object
Dim oMail As object

 

[lneidorf]

Alas no luck either way.
First approach errors out almost immediately.
Second errors out when it encounters that first Cal Invite acceptance. Same as before.

 

[lneidorf]

This
if oItem.messageclass ="ipm.note" then

would replace

If TypeName(oItem) = "MailItem" Then

Did it error or just not work?


Or... change the dim 's from mailitem to object - that should work with any items as long as it has the fields you need.
Dim olMailItem As object
Dim oMail As object

CORRECTION:
First approach technically completes, with no data populated except the headers and a couple lines of the formula {Range("D2").Value = "=MID(E2,FIND(75,E2,1),7)"}.
Second errors out when it encounters that first Cal Invite acceptance. Same as before.

 

[Diane Poremsky]

I will test it.