Runtime error 438 - Outlook

[mrshl9898]

Good morning/afternoon/evening,

I'm trying to pull in some email data and have the below error on the Debug line.

I have the Outlook 16.0 Reference Library added.

Any suggestions?

Many thanks.

Sub GetFromOutlook()

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim myitem As Object
Dim i As Integer
Dim myDate As Date
Dim sht As Worksheet

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myitems = myInbox.Items
Set sht = Sheets("Data")
myDate = Date
i = 1


For Each myitem In myitems
Debug.Print myitem.ReceivedTime
    If myitem.ReceivedTime >= myDate And InStr(1, myitem.Subject, "Town") > 0 Then
        sht.Cells(i + 1, 1) = myitem.Subject
        sht.Cells(i + 1, 2) = myitem.ReceivedTime
        sht.Cells(i + 1, 3) = myitem.SenderName
        sht.Cells(i + 1, 4) = myitem.Body
        i = i + 1
    End If
Next myitem

End Sub

 

[Kenneth Hobson]

There is more than one type of item. You can get the one you want by either method:

Debug.Print TypeName(myItem)="MailItem", myItem.Class=olMail

If either is true, then your code should "work".

 

[mrshl9898]

Many thanks for the reply. I still seem to be missing something though.

Both were True

Error now occurring on:

If myitem.ReceivedTime >= myDate And myitem.Subject = "Export Issues" Then

Sub GetFromOutlook()

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
''Dim myitem As Object
Dim i As Integer
Dim myDate As Date
Dim sht As Worksheet

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myitems = myInbox.Items
Set sht = Sheets("Data")
myDate = Date
i = 2


For Each myitem In myitems
If myitem.Class = olMail Then
    If myitem.ReceivedTime >= myDate And myitem.Subject = "Export Issues" Then
        sht.Cells(i + 1, 1) = myitem.Subject
        sht.Cells(i + 1, 2) = myitem.ReceivedTime
        sht.Cells(i + 1, 3) = OutlookMail.SenderName
        sht.Cells(i + 1, 4) = myitem.Body
        i = i + 1
    End If
    If myitem.ReceivedTime >= myDate And myitem.Subject = "Import Issues" Then
        sht.Cells(i + 1, 1) = myitem.Subject
        sht.Cells(i + 1, 2) = myitem.ReceivedTime
        sht.Cells(i + 1, 3) = OutlookMail.SenderName
        sht.Cells(i + 1, 4) = myitem.Body
        i = i + 1
    End If
End If
Next myitem

End Sub

 

[mrshl9898]

EDIT: Looks like ReceivedTime isn't valid.

Is there a way to only search todays emails? Ideally not searching the whole inbox

 

[Kenneth Hobson]

I recommend that users always use Option Explicit as first line in a module and Debug > Compile before a run. As such, you should uncomment the myitem Dim line and change the two "OutlookMail." lines to myitem...

I had no error in my run.

 

[Kenneth Hobson]

This seems to work for me.

If myitem.ReceivedTime >= myDate Then Debug.Print myitem.Subject

Maybe your subject line check is the issue for not listing a mailitem?

 

[mrshl9898]

This is fine, looks to be ReceivedTime was the issue.

I'll get the team to move it to a seperate folder and keep it clean to avoid excessive running times.

Many thanks for the help.

Sub GetFromOutlook()

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim myitem As Object
Dim i As Integer
Dim myDate As Date
Dim sht As Worksheet

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("Owens Test")
Set myitems = myInbox.Items
Set sht = Sheets("Data")
myDate = Date
i = 2


For Each myitem In myitems
If myitem.Class = olMail Then
Debug.Print myitem.Class
Debug.Print myitem.Subject
    If myitem.Subject = "Export Issues" Then
        sht.Cells(i + 1, 2) = myitem.ReceivedTime
        sht.Cells(i + 1, 4) = myitem.Body
        i = i + 1
    End If
    If myitem.Subject = "Import Issues" Then
        sht.Cells(i + 1, 2) = myitem.ReceivedTime
        sht.Cells(i + 1, 3) = myitem.SenderName
        i = i + 1
    End If
End If
Next myitem

End Sub