Outlook VBA宏将邮件从子文件夹移动到子文件夹 [英] Outlook VBA Macro to move mail from subfolder to subfolder

问题描述

我目前在运行VBA脚本时遇到一个小问题.

I am currently encountering a slight issue with running a VBA script.

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"子文件夹-完美运行.

Basically the above code moves all the mail items with attachments that contain a .ber file type from my inbox folder to the '.PathErrors' subfolder - this works perfectly.

但是我想做的是将邮件从另一个子文件夹'.AllPathMails'移到'.PathErrors'，如果它们包含带有.ber文件类型的附件.

However what I want to do is move mails from a different sub folder '.AllPathMails' to '.PathErrors' if they contain an attachment with a .ber file type.

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

I tried the following code but it doesn't work:

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"部分有问题吗?

Am I doing something wrong here? I believe it could be the 'Session.GetDefaultFolder' part that's faulty?

推荐答案

如果

这两个文件夹分别命名为 .AllPathMails 和 .PathErrors

the two folders are named .AllPathMails and .PathErrors

AND

它们是您收件箱的子文件夹，如下所示:

They are SubFolders of your Inbox and depicted below:

 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

这篇关于Outlook VBA宏将邮件从子文件夹移动到子文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！