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

如何更换

STRING

通过

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到达正确的文件夹）

每月存档中复制电子邮件

1 个答案: