0

我试图实现一个脚本来将一个特定的邮件移动到一个新的文件夹 - 没有困难的东西。它在 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->2013-XX取决于当前月份。

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

我究竟做错了什么？干杯。

4

1 回答 1

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
于 2013-09-10T13:04:34.223 回答