Search code examples
excelvbaoutlook

Return mailitem property from item in inbox: Run time error '438': object doesn't support this property or method"

I am attempting to write Excel VBA code to do the following:

Loop through emails in the Outlook inbox that were received within the past 96 hours and meet certain criteria.
Extract data from the body of the email.
Enter it into the corresponding row and columns in a specified sheet in an Excel workbook.

Sub ImportEmailData()
    Dim olApp As Object
    Dim olNs As Object
    Dim olFolder As Object
    Dim olMail As Object
    Dim i As Integer
    Dim strSheet As String
    Dim lastrow As Long

    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set olFolder = olNs.GetDefaultFolder(6) '6 is the default folder index for Inbox

    strSheet = "Sheet1" 'Enter the name of the sheet where you want to paste the data

    lastrow = Sheets(strSheet).Cells(Rows.Count, 1).End(xlUp).Row + 1 'Find the last row in the sheet
    
    Debug.Print "Start of loop"
    Debug.Print "----------------"

    For Each olMail In olFolder.Items.Restrict("[ReceivedTime] >= '" & Format(DateAdd("h", -96, Now), "ddddd h:nn AMPM") & "'") 'Loop through each email in the inbox that was received within the past 96 hours
        Debug.Print "Processing email..."
        
        If InStr(olMail.Body, "booking confirmation") > 0 And (olMail.SenderEmailAddress = "[email protected]" Or olMail.SenderEmailAddress = "[email protected]") Then 'Check if the string "booking confirmation" is found within the body text of the email and if the sender is either "[email protected]" or "[email protected]"
            'Extract the data from the email and enter it into the corresponding row and columns in the sheet
            With Sheets(strSheet)
                For i = 2 To lastrow
                    If InStr(Sheets(strSheet).Cells(i, 1).Value, olMail.Subject) > 0 Then 'Check if the subject line of the email matches the order number in the sheet
                        Debug.Print "Match found on row " & i
                        .Cells(i, 4).Value = Trim(Mid(olMail.Body, InStr(olMail.Body, "Carrier Booking#") + 16, 11))  'Enter the first 11 characters following "Carrier Booking#" in the corresponding row and column D and trim blank spaces
                        .Cells(i, 5).Value = Trim(Mid(olMail.Body, InStr(olMail.Body, "ABC Doc Cut:") + 12, 5)) 'Enter the first 5 characters following "ABC Doc Cut:" in the corresponding row and column E and trim blank spaces
                        .Cells(i, 6).Value = "booking received" 'Enter "booking received" in column F for the matching row
                        Exit For 'Exit the loop once the matching row is found
                    End If
                Next i
            End With
        End If
    Next olMail

    Set olApp = Nothing
    Set olNs = Nothing
    Set olFolder = Nothing
    Set olMail = Nothing

End Sub

Step-by-step breakdown of what the code should do:

  1. Declare the necessary variables and create objects for the Outlook application and namespace.
  2. Set the default inbox folder and specify the sheet where the data will be pasted.
  3. Find the last row in the sheet.
  4. Loop through each email in the inbox that was received within the past 96 hours.
  5. Check if the email contains the string "booking confirmation" and if the sender is either "[email protected]" or "[email protected]".
  6. If the email meets the criteria, extract the data from the email and enter it into the corresponding row and columns in the sheet.
  7. Check if the subject line of the email matches the order number in the sheet.
  8. Enter the first 11 characters following "Carrier Booking#" in the corresponding row and column D and trim any blank spaces.
  9. Enter the first 5 characters following "ABC Doc Cut:" in the corresponding row and column E and trim any blank spaces.
  10. Enter "booking received" in column F for the matching row.
  11. Exit the loop once the matching row is found.
  12. Release the objects created for the Outlook application and namespace.

I receive the error message

Run time error '438': object doesn't support this property or method

The following line is higlighted:

If InStr(olMail.Body, "booking confirmation") > 0 And
(olMail.SenderEmailAddress = "[email protected]" Or olMail.SenderEmailAddress = "[email protected]") Then

I tried the following:

Dim olMail As Outlook.MailItem
Set olMail = olFolder.Items.Restrict("[ReceivedTime] >= '" & Format(DateAdd("h", -96, Now), "ddddd h:nn AMPM") & "'").Item(1)
Solution

  • When I run the macro I receive the error message "Run time error '438': object doesn't support this property or method"

    The fact is that Outlook folders may contain different kind of items - mail, appointment, note, document and etc.

    So, you need to declare the common item as object:

    Dim olItem As Object
Set olItem = olFolder.Items.Restrict("[ReceivedTime] >= '" & Format(DateAdd("h", -96, Now), "ddddd h:nn AMPM") & "'").Item(1)

    After getting an item you can check the underlying item type by checking the MessageClass property or type at runtime. Only after that you may cast the object to the underlying type and access specific properties.

    You can find the sample code and read more about the Restrict method in the How To: Use Restrict method to retrieve Outlook mail items from a folder article which I wrote for the technical blog.