使用辅助收件箱中的VBA在Outlook中保存附件

时间:2016-02-02 18:02:14

标签: vba outlook outlook-vba

我一直试图在共享的收件箱中触发。

我可以使用我在Inbox上使用for循环手动调用的脚本来正常工作。

我也可以使用Session.GetDefaultFolder(olFolderInbox).Items使用我的主收件箱来解决这个问题。

对我出错的地方有任何帮助吗?

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
    Dim ns As NameSpace
    Dim olInboxItems As MAPIFolder
    Set ns = Application.GetNamespace("MAPI")
    Set objOwner = ns.CreateRecipient("xx@xx.com")
    Set olInboxItems = ns.GetSharedDefaultFolder(objOwner, olFolderInbox)
    Debug.Print ns
    Debug.Print objOwner
    Debug.Print olInboxItems
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

    On Error Resume Next

    Dim olMailItem As MailItem
    Dim strAttachmentName As String
    '
    ' Only inspect mail items
    ' Ignore appointments, meetings, tasks, etc.
    '
    If TypeOf Item Is MailItem Then
        Debug.Print MailItem
        Set olMailItem = Item
        If olMailItem.Attachments.Count = 1 Then
            strAttachmentName = olMailItem.Attachments.Item(1).FileName
            olMailItem.Attachments.Item(1).SaveAsFile "C:\EmailAttachments\" + strAttachmentName
        End If
    End If
    Set Item = Nothing
    Set olMailItem = Nothing
End Sub

3 个答案:

答案 0 :(得分:1)

您将变量声明为Items,但是将其分配给MAPIFolder对象的实例。 将该代码更改为

Set olInboxItems = ns.GetSharedDefaultFolder(objOwner, olFolderInbox).Items

答案 1 :(得分:1)

德米特里发现了这个问题 - 矛盾的声明。

潜在的问题是滥用

On Error Resume Next

" It is very important to remember that On Error Resume Next does not in any way "fix" the error. It simply instructs VBA to continue as if no error occured."

和不使用

Option Explicit

你可能已经找到了。

Dim olInboxItems As Items
Set olInboxItems = ns.GetSharedDefaultFolder(objOwner, olFolderInbox).Items

而不是

Dim olInboxItems As MAPIfolder

答案 2 :(得分:0)

或者你可以这样做 -

td