我有一个代码,用于复制档案中超过2天的电子邮件,但如果我想将电子邮件复制到存档子文件夹中,则不会执行此项工作。欢迎任何帮助。复制存档子文件夹中的旧电子邮件
Sub Copy_d_2()
Dim myOutlookFolders As Outlook.Folder
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.Folder
Dim objSourceFolder As Outlook.Folder
Dim objSourceFolderMAIN As Outlook.Folder
Dim objDestFolder As Outlook.Folder
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As 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 me " & b & " " & c
Set objNamespace = Session.GetDefaultFolder(olFolderInbox)
Set objSourceFolder = Session.Folders("Mailbox - Share").Folders("Inbox").Folders("all emails")
Set objSourceFolderMAIN = Session.Folders("Archive Folders")
Set objDestFolder = Session.Folders("Archive Folders").Folders(nam).Folders("d2")
For intCount = objSourceFolder.Items.Count To 1 Step -1
Set objVariant = objSourceFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
If intDateDiff > 2 Then
objVariant.Copy objDestFolder
lngMovedItems = lngMovedItems + 1
End If
End If
Next
Set objDestFolder = Nothing
End Sub
你还需要帮助吗? – 0m3r