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

メッセージは folderに届きます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 に答える