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

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