메일을 월간 아카이브에 복사

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 위에 아니라 Dim myCopiedItem As Outlook.MailItem 같은 코드 주위에. 그들은 처음에 아무튼 초기화됩니다.

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 

교체에 대해