Outlook VBA宏：将邮件从子文件夹移动到另一个子文件夹

Question

我目前在运行VBA脚本时遇到了一些小问题。

Sub MovePathErrors(Item As Outlook.MailItem)

If Item.Attachments.Count > 0 Then

Dim attCount As Long
Dim strFile As String
Dim sFileType As String

attCount = Item.Attachments.Count

For i = attCount To 1 Step -1
      strFile = Item.Attachments.Item(i).FileName

      sFileType = LCase$(Right$(strFile, 4))

    Select Case sFileType
        Case ".ber"
    ' do something if the file types are found
    ' this code moves the message
      Item.Move (Session.GetDefaultFolder(olFolderInbox).Folders(".PathErrors"))

   ' stop checking if a match is found and exit sub
       GoTo endsub
      End Select
  Next i

End If

基本上以上的代码是将包含 .ber 文件类型的带有附件的所有邮件项目从我的收件箱文件夹移动到 '.PathErrors' 子文件夹 - 这很完美地实现了。

然而，我想要做的是，如果邮件中包含一个 .ber 文件类型的附件，则将来自另一个子文件夹 '.AllPathMails' 的邮件移动到 '.PathErrors'。

我尝试了下面的代码，但它不起作用：

Sub MovePathErrors(Item As Outlook.MailItem)

If Item.Attachments.Count > 0 Then

Dim attCount As Long
Dim strFile As String
Dim sFileType As String

attCount = Item.Attachments.Count

For i = attCount To 1 Step -1
      strFile = Item.Attachments.Item(i).FileName

      sFileType = LCase$(Right$(strFile, 4))

    Select Case sFileType
        Case ".ber"
    ' do something if the file types are found
    ' this code moves the message
      Item.Move (Session.GetDefaultFolder(".AllPathMails").Folders(".PathErrors"))

   ' stop checking if a match is found and exit sub
       GoTo endsub
      End Select
  Next i

End If

我这里有问题吗？ 我认为可能是'Session.GetDefaultFolder'部分有问题？

- Eli Skywalker

---

欢迎来到Stackoverflow。我正在努力执行第一段代码，以移动带有“.ber”附件的电子邮件。请问您能指示如何执行该代码以及放置在哪里吗？ - Jean-Pierre Oosthuizen

嗨@Jean-PierreOosthuizen，谢谢。请参阅Diane Poremsky的实现：[链接]（http://www.slipstick.com/developer/code-samples/use-vba-move-messages-based-values-fields） - Eli Skywalker

".AllPathMails"文件夹和".PathErrors"文件夹的确切位置在哪里？它们是您收件箱的子文件夹还是您文件柜的一部分？ - Jean-Pierre Oosthuizen

@Jean-PierreOosthuizen 是的，这些只是我Outlook收件箱的子文件夹。 - Eli Skywalker

Answer 1

如果这两个文件夹的名称分别为.AllPathMails和.PathErrors，并且它们是你收件箱的子文件夹，并显示如下，则此方法可行：

 Option Explicit
 Sub MoveEmailsBetweenFoldersDependingOnAttachmentType()

      Dim AllPathMailsFolderList As Outlook.MAPIFolder
      Set AllPathMailsFolderList = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders(".AllPathMails")

      Dim CurrentItem As Object
      Dim CurrentAttachment As Outlook.Attachment
      Dim AttachmentName As String
      Dim AttachmentFileType As String

      For Each CurrentItem In AllPathMailsFolderList.Items

           If CurrentItem.Attachments.Count > 0 Then

                For Each CurrentAttachment In CurrentItem.Attachments

                     AttachmentName = CurrentAttachment.FileName
                     AttachmentFileType = LCase$(Right$(AttachmentName, 4))

                     If AttachmentFileType = ".ber" Then
                          'CurrentItem.Move (GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders(".PathErrors"))
                     End If

                Next CurrentAttachment

           End If

      Next CurrentItem

 End Sub

- Jean-Pierre Oosthuizen

---

完美的@Jean-PierreOosthuizen，这个可行。简直不敢相信这让我整天烦恼！非常感谢你。 - Eli Skywalker