Question

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

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

第3列是我提取的电子邮件的主题，我使用restrict方法进行Outlook来返回带有特定标题的电子邮件

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

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

Column 3      columnn 8

A                 1
B                 2
C                 2
D                 1
E                 1

我使用数组的原因是因为每次提取数据时，列表都会更改，因此它是动态的。因此，我使用LBound和UBound来包括发票的整个列表。

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

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

使用VBA遍历阵列，将Outlook电子邮件从一个文件夹移动到另一个文件夹？

1 个答案: