复制每月存档中的电子邮件
Copy emails in monthly archive
我必须每天在每月存档中复制超过 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
这是一种可能,检查当前日期。如果小于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
这样的代码周围。无论如何,它们在一开始就被初始化了。
更换怎么样
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
来自
Dim nam As String
nam = "Archive " & format(now()-2, "mmm yyyy")
(-2 以到达正确的文件夹)
我必须每天在每月存档中复制超过 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
这是一种可能,检查当前日期。如果小于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
这样的代码周围。无论如何,它们在一开始就被初始化了。
更换怎么样
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
来自
Dim nam As String
nam = "Archive " & format(now()-2, "mmm yyyy")
(-2 以到达正确的文件夹)