使用 VBA 循环遍历数组，将 Outlook 电子邮件从一个文件夹移动到另一个文件夹？

Question

我想将发票电子邮件从主文件夹移动到另一个文件夹。

我在第一个模块中从 Outlook 中提取了带有 VBA 的电子邮件的主题，它们在第 3 列中。然后我在第 8 列中手动写出我希望电子邮件移动到的文件夹。（文件夹是子文件夹）

第3列是我提取的邮件的主题，我使用outlook的restrict方法返回带有特定标题的邮件

第 8 列是我希望电子邮件也移动的文件夹。

示例如下 该代码必须将电子邮件放在主文件夹中，主题为“A”到文件夹“1”

Column 3      columnn 8

A                 1
B                 2
C                 2
D                 1
E                 1

我使用数组的原因是，每次提取时，列表都会发生变化，因此它是动态的。因此，我使用 LBound 和 UBound 来包含整个发票列表。

我已将第一个模块中的所有变量声明为“公共”。这里只把相关的留给代码

Sub MovingEmails_Invoices()

  'Declare your Variables
    Dim i As Object
    Dim myitems As Object
    Dim subfolder As Outlook.Folder 


    'Set Outlook Inbox Reference
    Set OP = New Outlook.Application
    Set NS = OP.GetNamespace("MAPI")

    'To loop through subfolder and its folders
    Set rootfol = NS.Folders("SYNTHES-JNJCZ-GBS.DE.AT.CH@ITS.JNJ.com")
    Set Folder = rootfol.Folders("Austria")

'The list for invoice numbers and folders is dynamic
'Each subject being searched is different

Dim Listmails() As Variant
Dim Rowcount As Long
Dim Mailsubject As Variant
Dim FolderName As Variant
Dim MS As String
Dim myrestrictitem As Outlook.items

 'Establish the array based on the mailbox extract
  Sheets("files").Activate
  Listmails = Range("A2").CurrentRegion


'Ititerate through the array which is dynamic (One-dimensional)
For Rowcount = LBound(Listmails) To UBound(Listmails)

'3rd row for email subject 'used DASL Filter
Mailsubject = Application.WorksheetFunction.Index(Listmails, Rowcount, 3)
MS = "urn:schemas:mailheader:subject LIKE \'%" & Mailsubject & "%\'"

    'Find the email based on the array for email subject
    Set myitems = Folder.items
    Set myrestrictitem = myitems.Restrict(MS)

        For each i in myrestrictitem
        If i.class = olmail then

         '8th row for folder name
         FolderName = Application.WorksheetFunction.Index(Listmails, Rowcount,8) 
         Set subfolder = rootfol.Folders(FolderName) ' i have an error here

         'If email found then mark it as read
         i.UnRead = False

         'Move it to the subfolder based on the array for folder name
         i.Move subfolder

Next Rowcount

End Sub

现在，我使用从 Microsoft Office Center 获得的示例来构建限制部分，本页的最后一个示例：https://docs.microsoft.com/en-us/office/vba/api/outlook.items.restrict

当我尝试以同样的方式进行操作时，它对我的​​代码不起作用。

错误信息来自；

Set myrestrictitem = myitems.Restrict(MS)

和 ?

Set subfolder = rootfol.Folders(FolderName)

错误信息是条件不正确。也可能是因为我的循环不正确。

是否有另一种方法可以做到这一点，也许没有数组？我需要 IF 条件吗？

Answer 1

您的条件必须包含@SQL= 前缀。双引号 DASL 属性名称也是一个好主意：

@SQL="urn:schemas:mailheader:subject" LIKE '%test%'

在更改集合时（通过调用 Move），您也不应该使用“for each”。使用向下循环：

for i = myrestrictitem.Count to 1 step -1
  set item =  myrestrictitem.Item(i)
  ..
  item.Move subfolder