在所有收件箱子文件夹中搜索包含一个电子邮件ID的邮件

Question

要查找自上个月以来收件箱子文件夹中的所有电子邮件（按文件夹名称，即电子邮件ID），并按主题将其复制粘贴到相应的文件夹中。

我仍然遇到代码 NS = OlApp.GetNamespace（＆＃34; MAPIFolder＆＃34;）以及（＆＃34; MAPI＆＃34;）以及对象变量的错误没有set正在显示

Dim OlApp As Outlook.Application
Set OlApp = New Outlook.Application
Set OlApp = CreateObject("Outlook.Application")
Dim fldrpath As String
Dim fldername As String
Dim oMail As Object
fldrpath = "\data\EMAILS\" & fldrname
Dim NS As Namespace
Dim Folder As MAPIFolder
Dim sName As String
Dim dtdate As String
Dim Inbox As MAPIFolder
NS = OlApp.GetNamespace("MAPIFolder")
Set Inbox = NS.GetDefaultFolder(olFolderInbox)
For Each mysubFolders In Inbox.subFolders
Set mysubfolder = Inbox.subFolders("PDI").Folders("OBU").Folders("DND")
For Each mailItems In mysubfolder
If oMail.Body = r Then
Set mailItems = oMail
sName = mailItems.Subject
dtdate = mailItems.ReceivedTime
Debug.Print fldrpath & sName
mailItems.SaveAs fldrpath & sName, olMSG
End If
 Next
Set OlApp = Nothing
Set mailItems = Nothing
Next
End Sub

Answer 1

第一个问题是这一行，缺少Set关键字：

设置NS = OlApp.GetNamespace（＆＃34; MAPIFolder＆＃34;）

然后你正在访问＆＃34; Inbox.subFolders＆＃34;，但是Folder对象上没有这样的属性;它将是您想要的Folders属性集合。

你也没有在循环中使用mysubFolders变量，因此整个代码块都会失败。您还没有尝试从mysubfolder对象迭代的mailItems对象的显式集。

我继续但坦率地说整个方法需要重写。专注于确保您声明并将正确的变量设置为正确的属性或对象。