毎月のアーカイブでメールをコピーする

Question

毎月のアーカイブで2日以上経過したメールをコピーする必要があります。私の問題は、今日は01または02 .12.2016場合は、私は現在の月の前に電子メールを移動する必要があります - 11.2016。私はコードが正しくない - 電子メールの日付がT-2で、電子メールの月が現在のものでない場合、現在の月の前の月に電子メールを移動し、現在の月のアーカイブに移動する。助けを歓迎します、ありがとうございます。

Sub Archive_Outlook_eMails_To_Backup_PST_Folder() 
    Dim SourceFolder As Outlook.MAPIFolder, DestFolder As Outlook.MAPIFolder 
    Dim MailItem As Outlook.MailItem 
    Dim SourceMailBoxName As String, DestMailBoxName As String 
    Dim Source_Pst_Folder_Name As String, Dest_Pst_Folder_Name As String 
    Dim MailsCount As Double, NumberOfDays As Double 


Dim a As Date 
a = Now() 

Dim b As String 
b = Format(a, "mmmm") 

Dim c As String 
c = Format(a, "yyyy") 

Dim nam As String 
nam = "Archive " & b & " " & c 


    NumberOfDays = 2 

    Source_Pst_Folder_Name = "Inbox" 
    Set SourceFolder = Session.Folders("Mailbox - Share ALL").Folders("Inbox").Folders("0.Archive") 

    DestMailBoxName = nam 
    Dest_Pst_Folder_Name = "0.Archive" 
    Set DestFolder = Outlook.Session.Folders(DestMailBoxName).Folders(Dest_Pst_Folder_Name) 

    MailsCount = SourceFolder.Items.Count 
    While MailsCount > 0 


     Set MailItem = SourceFolder.Items.Item(MailsCount) 
     If VBA.DateValue(VBA.Now) - VBA.DateValue(MailItem.ReceivedTime) >= NumberOfDays Then 
      Dim myCopiedItem As Outlook.MailItem 
      Set myCopiedItem = MailItem.Copy 
      myCopiedItem.Move DestFolder 

     End If 

     MailsCount = MailsCount - 1 

    Wend 

    MsgBox "Mailes in " & Source_Pst_Folder_Name & " are Processed" 
End Sub 

Answer 1

現在の日付を確認する可能性があります。それが3未満である場合は、特定の場合に行く：改善のための

Sub Archive_Outlook_eMails_To_Backup_PST_Folder() 
    Dim SourceFolder As Outlook.MAPIFolder, DestFolder As Outlook.MAPIFolder 
    Dim MailItem As Outlook.MailItem 
    Dim SourceMailBoxName As String, DestMailBoxName As String 
    Dim Source_Pst_Folder_Name As String, Dest_Pst_Folder_Name As String 
    Dim MailsCount As Double, NumberOfDays As Double 


Dim a As Date 
a = Now() 

Dim b As String 
b = Format(a, "mmmm") 

Dim c As String 
c = Format(a, "yyyy") 

Dim nam As String 
nam = "Archive " & b & " " & c 


    NumberOfDays = 2 

    Source_Pst_Folder_Name = "Inbox" 
    Set SourceFolder = Session.Folders("Mailbox - Share ALL").Folders("Inbox").Folders("0.Archive") 

    DestMailBoxName = nam 
    Dest_Pst_Folder_Name = "0.Archive" 
    Set DestFolder = Outlook.Session.Folders(DestMailBoxName).Folders(Dest_Pst_Folder_Name) 

    MailsCount = SourceFolder.Items.Count 
    While MailsCount > 0 


     Set MailItem = SourceFolder.Items.Item(MailsCount) 
     If VBA.DateValue(VBA.Now) - VBA.DateValue(MailItem.ReceivedTime) >= NumberOfDays Then 
     Select Case VBA.Now 

     Case Is < 3: 
      Dim myCopiedItem As Outlook.MailItem 
      Set myCopiedItem = MailItem.Copy 
      myCopiedItem.Move DestFolder 'The folder should be changed 

     Case Else: 
      Dim myCopiedItem As Outlook.MailItem 
      Set myCopiedItem = MailItem.Copy 
      myCopiedItem.Move DestFolder 

     End If 

     MailsCount = MailsCount - 1 

    Wend 

    MsgBox "Mailes in " & Source_Pst_Folder_Name & " are Processed" 
End Sub 

ただ一つの小さなアイデア - Dim myCopiedItem As Outlook.MailItemのようなコードの周りのトップではなく上のすべてのごdimを置きます。彼らは最初から何とか初期化されています。

Answer 2

どう

Dim nam As String 
nam = "Archive " & format(now()-2, "mmm yyyy") 

によって

Dim a As Date 
a = Now() 

Dim b As String 
b = Format(a, "mmmm") 

Dim c As String 
c = Format(a, "yyyy") 

Dim nam As String 
nam = "Archive " & b & " " & c 

を交換（-2正しいフォルダに到達するために）