Reference to one account of many in OutLook, error 438

Question

This Code works on my personal computer with two accounts. (OutLook 2013.)

At work where I have four accounts I get the following error message (OutLook 2007.):

"Excel VBA, error 438 "object doesn't support this property or method"

Code (MSG box messages are in Swedish):

Sub GetAttachments()
On Error GoTo GetAttachments_err
    Dim ns As NameSpace
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Dim varResponse As VbMsgBoxResult
    Dim oStore As Store
    Dim Inbox As MAPIFolder
    Dim bFound As Boolean

    For Each oStore In Outlook.Session.Stores
        If oStore = "[email protected]" Then
            Set Inbox = oStore.GetDefaultFolder(olFolderInbox)
            bFound = True
            Exit For
        End If
    Next oStore

    If Not bFound Then
        MsgBox ("Account '[email protected]' not found")
        Exit Sub
    End If

    Set ns = GetNamespace("MAPI")
    i = 0

    If Inbox.Items.Count = 0 Then
        MsgBox "Det finns inga meddelanden i din Inbox.", vbInformation, _
                "Hittade inget"
        Exit Sub
    End If

    If Inbox.UnReadItemCount = 0 Then
        MsgBox "Det finns inga nya meddelanden i din Inbox.", vbInformation, _
                "Hittade inget"
        Exit Sub
    End If

    For Each Item In Inbox.Items
        For Each Atmt In Item.Attachments
            If Item.UnRead = True Then
                If Right(Atmt.FileName, 3) = "pdf" Then
                    FileName = "C:\Users\xxx\Desktop\Inboxtest\" & 
                    Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
                    Atmt.SaveAsFile FileName
                    i = i + 1
                End If
            End If
        Next Atmt
    Next Item

    If i > 0 Then
        varResponse = MsgBox("Jag har hittat " & i & " bifogade .pdf filer." _
                                & vbCrLf & "Jag har sparat dem till C:\Users\xxx\Desktop\Inboxtest\" _
                                & vbCrLf & vbCrLf & "Vill du se dina sparade filer nu?" _
                                , vbQuestion + vbYesNo, "Klart!")
        If varResponse = vbYes Then
            Shell "Explorer.exe /e,C:\Users\xxx\Desktop\Inboxtest\", vbNormalFocus
        End If
    Else
        MsgBox "Jag hittade inga bifogade .pdf filer i din mail.", vbInformation, _
                "Klar!"
    End If

GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub

GetAttachments_err:
    MsgBox "A ghost messed something up!" 
            & vbCrLf & "Please note and report the following information." _
            & vbCrLf & "Macro Name: GetAttachments" _
            & vbCrLf & "Error Number: " & Err.Number _
            & vbCrLf & "Error Description: " & Err.Description _
            , vbCritical, "Error!"
    Resume GetAttachments_exit
    Exit Sub
End Sub

Answer 1

What line of code causes the error? Did you try to debug the code?

All Outlook object model properties and methods exist in Outlook 2007. I don't see any new members in the code. Try to use complete property defionitions:

Set ns = GetNamespace("MAPI")

use the following statment instead:

Set ns = Application.GetNamespace("MAPI")

Also I'd recommend breaking the chain of calls and declare a property or method call on a single line of code. Don't use multiple dots in the single line of code.

For Each Item In Inbox.Items

Use the Find/FindNext or Restrict methods of the Items class to find the subset of items that correspond to the condition.