Question

我试图实现一个脚本来将特定邮件移动到新文件夹 - 没有什么难事。它在Outlook 2013中编写脚本，并作为传入邮件的规则实施。代码：

Public Sub MoveToFolder(Item As Outlook.MailItem) 
  '' ... variable definitions ... 
  Set oloUtlook = CreateObject("Outlook.Application")
  Set ns = oloUtlook.GetNamespace("MAPI")
  Set itm = ns.GetDefaultFolder(olFolderInbox)
  Set foldd = ns.Folders.GetFirst.Folders

  For x = 1 To foldd.Count
    If foldd.Item(x).Name = "Inbox" Then
        Set fold = foldd.Item(x).Folders
        For i = 1 To fold.Count
            If fold.Item(i).Name = "Reports" Then
                If fold.Item(i).Folders.GetFirst.Name <> Format(Date, "yyyy-mm") Then
                    fold.Item(i).Folders.Add (Format(Date, "yyyy-mm"))
                End If
                Set newfold = fold.Item(i).Folders.GetFirst
                MsgBox newfold.Name
                Item.Copy (newFold)
                ''Item.Move (newfold)
            End If
        Next i
    End If
  Next x
End Sub

消息来到文件夹Inbox，我想将其移至： Reports - ＆gt; 2013-XX取决于当前月份。

MessageBox显示正确的文件夹名称。但邮件将作为副本复制到“收件箱”文件夹中。

我做错了什么？欢呼声。

Answer 1

我不确定为什么你的方法不起作用。当我在2010年运行它时，它会获得正确的文件夹。我不确定为什么你认为当前的日期文件夹永远是第一个文件夹，但我从来没有使用过GetFirst，所以也许我只是不理解它。这是一种更直接的测试和创建文件夹的方法，它可能适合您。

Public Sub MoveToFldr(Item As MailItem)

    Dim oFldr As Folder
    Dim fReports As Folder

    Set fReports = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Reports")

    On Error Resume Next
        Set oFldr = fReports.Folders(Format(Date, "yyyy-mm"))
    On Error GoTo 0

    If oFldr Is Nothing Then
        Set oFldr = fReports.Folders.Add(Format(Date, "yyyy-mm"))
    End If

    Item.Move oFldr

End Sub

MailItem移动到错误的文件夹

1 个答案: