Outlook VBA保存附件代码失败

Question

我在网上找到了我想用来保存电子邮件文件夹中附件的代码，但是它不起作用。 我不是一个程序员，并且看起来很适合我的需求。 如果有人可以解决此问题而不是建议其他代码，将不胜感激。 我正在使用Outlook 2007，并且Outlook文件夹的名称正确。 谢谢！

http://www.vbaexpress.com/kb/getarticle.php?kb_id=522#instr

代码在以下位置失败：

Set TargetFolderItems = ns.Folders.Item( _
"Personal Folders").Folders.Item("Temp").Items 

并给出错误信息：

'运行时错误'-2147221233（8004010f）'：操作失败。 找不到对象”

任何帮助将非常感激。

---

'###############################################################################
 '### Module level Declarations
 'expose the items in the target folder to events
Option Explicit 
Dim WithEvents TargetFolderItems As Items 
 'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\********\" 

 '###############################################################################
 '### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup() 
     'some startup code to set our "event-sensitive" items collection
    Dim ns As Outlook.NameSpace 
     '
    Set ns = Application.GetNamespace("MAPI") 
    Set TargetFolderItems = ns.Folders.Item( _ 
    "Inbox").Folders.Item("BS CDGL").Items 

End Sub 

 '###############################################################################
 '### this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object) 
     'when a new item is added to our "watched folder" we can process it
    Dim olAtt As Attachment 
    Dim i As Integer 

    If Item.Attachments.Count > 0 Then 
        For i = 1 To Item.Attachments.Count 
            Set olAtt = Item.Attachments(i) 
             'save the attachment
            olAtt.SaveAsFile FILE_PATH & olAtt.FileName 

             'if its an Excel file, pass the filepath to the print routine
            If UCase(Right(olAtt.FileName, 3)) = "XLS" Then 
                PrintAtt (FILE_PATH & olAtt.FileName) 
            End If 
        Next 
    End If 

    Set olAtt = Nothing 

End Sub 

 '###############################################################################
 '### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit() 

    Dim ns As Outlook.NameSpace 
    Set TargetFolderItems = Nothing 
    Set ns = Nothing 

End Sub 

 '###############################################################################
 '### print routine
Sub PrintAtt(fFullPath As String) 

    Dim xlApp As Excel.Application 
    Dim wb As Excel.Workbook 

     'in the background, create an instance of xl then open, print, quit
    Set xlApp = New Excel.Application 
    Set wb = xlApp.Workbooks.Open(fFullPath) 
    wb.PrintOut 
    xlApp.Quit 

     'tidy up
    Set wb = Nothing 
    Set xlApp = Nothing 

End Sub 

Answer 1

您已跳过文件夹。

更改

Set TargetFolderItems = ns.Folders.Item( _ 
"Inbox").Folders.Item("BS CDGL").Items 

至

Set TargetFolderItems = ns.Folders.Item("Other Mailbox Name").Folders.Item( _ 
"Inbox").Folders.Item("BS CDGL").Items