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'子文件夹 - 这非常有效。

但是，我想要做的是将邮件从不同的子文件夹“.AllPathMails”移动到“.PathErrors”，如果它们包含带有.ber文件类型的附件。

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

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'部分有问题吗？

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