Question

我有Outlook 2010.我收到了相同主题行的电子邮件，并打开了PDF。当PDF打开时，Adobe会询问我是否要将其添加到Excel响应文件中，我说是。

当Adobe要求添加响应文件时，我想让它以“好的”回复，但我可以在没有它的情况下进行管理。在这一行：

Set SubFolder = Mailbox.Folders("Response File")

我收到错误：

尝试的操作失败。无法找到对象。

未读电子邮件所在的子文件夹在我的收件箱下方称为“！响应文件”（不含引号）。打开PDF后，我想将电子邮件标记为已读，并移至另一个名为“已提取”（不带引号）的子文件夹（在“收件箱”下）。

Sub GetAttachments()
  On Error GoTo GetAttachments_err
  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 i As Integer

  Set ns = GetNamespace("MAPI")
  Set Inbox = ns.GetDefaultFolder(olFolderInbox)
  Set Mailbox = Inbox.Parent
  Set SubFolder = Mailbox.Folders("!Response File")
  i = 0

  'check if there is any mail in the folder'
  If SubFolder.Items.Count = 0 Then
    MsgBox "There are no messages in the folder.", vbInformation, _
    "Nothing Found"
    Exit Sub
  End If

  'Check each message and save the attachment'
  If SubFolder.Items.Count > 0 Then
    For Each Item In SubFolder.Items
      If Item.UnRead = True Then
        For Each Atmt In Item.Attachments
          FileName = "C:\Users\abrupbac\Desktop\Response Emails\" & Atmt.FileName
          Atmt.SaveAsFile FileName 'saves each attachment'

          'this code opens each attachment'
          Set myShell = CreateObject("WScript.Shell")
          myShell.Run FileName

          'this sets the email as read'
          Item.UnRead = False
          'updates the counter'
          i = i + 1

        Next Atmt
      End If
    Next Item
  End If

  'Display results

  If i > 0 Then
    MsgBox "I found " & i & " attached files." _
     & vbCrLf & "They are saved on your desktop" _
     & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
  Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, _
     "Finished!"
 End If

'Replenish Memory'
GetAttachments_exit:

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

  'function for sorting the excel attachment'

GetAttachments_err:
  MsgBox "An unexpected error has occurred." _
  & 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
End Sub

Answer 1

欢迎来到StackOverflow！

要回答您的具体问题，

我得到了＃34;尝试的操作失败了。无法找到对象。＆＃34;错误：
Set SubFolder = Mailbox.Folders("!Response File")

您收到此错误是因为＆＃34;！响应文件＆＃34;不在收件箱的父级内。按名称查找文件夹可能很棘手。您可以通过ID访问该文件夹。获取所需文件夹ID的一种方法是编写一个函数来执行此操作。

    Function GetInboxFolderID(FolderName As String) As String
    Dim nsp As Outlook.Folder
    Dim mpfSubFolder As Outlook.Folder
    Dim mpfSubFolder2 As Outlook.Folder
    Dim flds As Outlook.Folders
    Dim flds2 As Outlook.Folders

    Set nsp = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set flds = nsp.Folders
    Set mpfSubFolder = flds.GetFirst
    Do While Not mpfSubFolder Is Nothing
        If mpfSubFolder.Name = FolderName Then
            GetInboxFolderID = mpfSubFolder.EntryID
            Exit Function
        End If
        Set flds2 = mpfSubFolder.Folders
        Set mpfSubFolder2 = flds2.GetFirst
        Do While Not mpfSubFolder2 Is Nothing
            If mpfSubFolder2.Name = FolderName Then
                GetInboxFolderID = mpfSubFolder2.EntryID
                Exit Function
            End If
            Set mpfSubFolder2 = flds2.GetNext
        Loop
        Set mpfSubFolder = flds.GetNext
    Loop
End Function

此外，这是一个测试它的代码。

Sub testing()
Dim tv As String
tv = GetInboxFolderID("Response File")
  Set myNewFolder = Application.Session.GetFolderFromID(tv)
 myNewFolder.Display

End Sub

此函数循环访问您的主要用户文件夹集，然后检查每个文件夹中的文件夹名称中给出的字符串。如果函数找到它，则它将ID返回到该文件夹。

测试子程序仅用于调试目的，当你运行它时，应该打开你在函数中命名的文件夹，即＃34;响应文件＆＃34;

更改行：

Set SubFolder = Mailbox.Folders("!Response File")

致：

Set SubFolder = Application.Session.GetFolderFromID(GetInboxFolderID("Response File"))

如果你实现我的功能，应该让你超越当前的错误。

此外，您可以关闭＆＃34;好的＆＃34;消息使用SendKeys

Call AppActivate("Adobe Reader", True)
 DoEvents
 SendKeys "{Enter}"

希望这有帮助！

用于移动邮件的收件箱的参考子文件夹

1 个答案: