在OutLook中引用了许多帐户,错误438

时间:2015-03-19 10:26:20

标签: vba outlook outlook-vba

此代码适用于具有两个帐户的个人计算机。 (OutLook 2013。)

在我有四个帐户的工作中,我收到以下错误消息(OutLook 2007。):

“Excel VBA,错误438”对象不支持此属性或方法“

代码(MSG信箱邮件是瑞典语):

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 = "invoice@xxx.com" Then
            Set Inbox = oStore.GetDefaultFolder(olFolderInbox)
            bFound = True
            Exit For
        End If
    Next oStore

    If Not bFound Then
        MsgBox ("Account 'invoice@xxx.com' 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

2 个答案:

答案 0 :(得分:0)

哪行代码会导致错误?您是否尝试调试代码?

Outlook 2007中存在所有Outlook对象模型属性和方法。我在代码中看不到任何新成员。尝试使用完整的属性defionition:

Set ns = GetNamespace("MAPI")

使用以下语句:

Set ns = Application.GetNamespace("MAPI")

此外,我建议打破调用链并在单行代码上声明属性或方法调用。不要在单行代码中使用多个点。

For Each Item In Inbox.Items

使用Items类的Find / FindNextRestrict方法查找与条件对应的项的子集。

答案 1 :(得分:0)

Outlook 2007中的商店对象不会公开GetDefaultFolder方法。

如果使用Redemption是一个选项,则它是RDOStore。GetDefaultFolder方法适用于所有版本的Outlook。