按月存檔複製電子郵件

我必須在每月存檔中複製超過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

來源

2016-12-05 wittman

這裏有一種可能性，檢查當前日期。如果小於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的代碼。無論如何，它們都是在初始階段初始化的。

來源

2016-12-05 09:04:32 Vityata

爲什麼要有人做呢？ _「把所有的模糊放在頂部而不是圍繞代碼」_ – SBF

這是VBA中的一個好習慣。如果是在代碼周圍，你必須考慮它們的位置並尋找它們。他們都立即初始化，無論他們是否處於狀態並不重要。 – Vityata

感謝您的幫助，我讓同事們瞭解代碼的每個模塊都做了些什麼。這樣更簡單。 – wittman

如何通過

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得到正確的文件夾）

來源

2016-12-13 10:22:50 user7290395

謝謝你。 – wittman

按月存檔複製電子郵件

回答

相關問題