Outlook VBA“尝试的操作失败”

我按照http://www.rondebruin.nl/win/s1/outlook/saveatt.htm的说明将附件从特定文件夹中的电子邮件保存到另一个文件夹。当我运行此代码时出现错误：Outlook VBA“尝试的操作失败”

An unexpected error has occurred.

Please note and report the following information.

Macro Name: SaveEmailAttachmentsToFolder

Error Number: -2147221233

Error Description: The attempted operation failed. An object could not be found.

宏是新的，所以不知道错误发生在哪里。有什么建议？

的代码如下：

Sub Test() 

    SaveEmailAttachmentsToFolder "MyFolder", "xls", "" 

End Sub 

Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _ 
           ExtString As String, DestFolder As String) 
    Dim ns As Namespace 
    Dim Inbox As MAPIFolder 
    Dim SubFolder As MAPIFolder 
    Dim Item As Object 
    Dim Atmt As Attachment 
    Dim FileName As String 
    Dim MyDocPath As String 
    Dim I As Integer 
    Dim wsh As Object 
    Dim fs As Object 

    On Error GoTo ThisMacro_err 

    Set ns = GetNamespace("MAPI") 
    Set Inbox = ns.GetDefaultFolder(olFolderInbox) 
    Set SubFolder = Inbox.Folders(OutlookFolderInInbox) 

    I = 0 
    ' Check subfolder for messages and exit of none found 
    If SubFolder.Items.Count = 0 Then 
     MsgBox "There are no messages in this folder : " & OutlookFolderInInbox, _ 
       vbInformation, "Nothing Found" 
     Set SubFolder = Nothing 
     Set Inbox = Nothing 
     Set ns = Nothing 
     Exit Sub 
    End If 

    'Create DestFolder if DestFolder = "" 
    If DestFolder = "" Then 
     Set wsh = CreateObject("WScript.Shell") 
     Set fs = CreateObject("Scripting.FileSystemObject") 
     MyDocPath = wsh.SpecialFolders.Item("mydocuments") 
     DestFolder = MyDocPath & "\" & Format(Now, "dd-mmm-yyyy hh-mm-ss") 
     If Not fs.FolderExists(DestFolder) Then 
      fs.CreateFolder DestFolder 
     End If 
    End If 

    If Right(DestFolder, 1) <> "\" Then 
     DestFolder = DestFolder & "\" 
    End If 

    ' Check each message for attachments and extensions 
    For Each Item In SubFolder.Items 
     For Each Atmt In Item.Attachments 
      If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then 
       FileName = DestFolder & Item.SenderName & " " & Atmt.FileName 
       Atmt.SaveAsFile FileName 
       I = I + 1 
      End If 
     Next Atmt 
    Next Item 

    ' Show this message when Finished 
    If I > 0 Then 
     MsgBox "You can find the files here : " _ 
      & DestFolder, vbInformation, "Finished!" 
    Else 
     MsgBox "No attached files in your mail.", vbInformation, "Finished!" 
    End If 

    ' Clear memory 
ThisMacro_exit: 
    Set SubFolder = Nothing 
    Set Inbox = Nothing 
    Set ns = Nothing 
    Set fs = Nothing 
    Set wsh = Nothing 
    Exit Sub 

    ' Error information 
ThisMacro_err: 
    MsgBox "An unexpected error has occurred." _ 
     & vbCrLf & "Please note and report the following information." _ 
     & vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _ 
     & vbCrLf & "Error Number: " & Err.Number _ 
     & vbCrLf & "Error Description: " & Err.Description _ 
     , vbCritical, "Error!" 
    Resume ThisMacro_exit 

End Sub

来源

2013-12-10 chinvpl

注释行On Error GoTo ThisMacro_err'然后告诉我们哪行给你错误？ –

指出错误。请参阅答案...或者看到我无法回答自己的问题...问题是我指定的文件夹实际上并未在收件箱中创建，与收件箱处于同一级别，因此它无法找不到文件夹。简单的事情... – chinvpl

抱歉无法添加答案，请参阅上面的评论。 – chinvpl

社区维基。答案在评论中。任何在搜索中发现此主题的人都会看到有答案，并且更有可能寻找有希望的有用答案。

“问题是，我指定不收件箱中实际创建的文件夹，它是在同一级别为收件箱，所以它无法找到该文件夹。简单的事情......” chinvpl

来源

2015-03-16 01:46:54 niton

Outlook VBA“尝试的操作失败”

回答

相关问题