将Outlook传入邮件移动到以相同代码开头的文件夹中

Question

我正在尝试自动将传入邮件移动到Outlook中指定的子文件夹。

包含格式为P000.0000的项目编号的邮件应移动到以相同项目编号开头的收件箱的子文件夹中。

子文件夹将手动预先创建，因此用户可以决定在专用子文件夹中汇总哪些项目。

文件夹结构为收件箱>活动>P000.0000

第一个部分，检查传入消息的地方工作正常，但在那之后我就迷路了。。。从For Each Folder In olFolderPrjcts 开始

错误在Set olFolder = objNS.GetDefaultFolder(olFolderInbox)这条线上

这就是我到目前为止想到的：

Private WithEvents myOlItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal item As Object)
Dim Atts As Outlook.Attachments
Dim Props As Outlook.UserProperties
Dim Prop As Outlook.UserProperty
Dim PropName As String
PropName = "NumberAttachments"
Set Atts = item.Attachments
Set Props = item.UserProperties
Set Prop = Props.Find(PropName, True)
If Prop Is Nothing Then
Set Prop = Props.Add(PropName, olText, True)
End If
Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Dim olFolderPrjcts
Set olFolderPrjcts = olFolder.Folders("actueel")
Prop.Value = Atts.Count
item.Save
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
For Each Folder In olFolderPrjcts
If Left(Msg.Subject, 9) = Left(Folder.Name, 9) Then
Msg.Move (Folder)
End If
Next
' DO SOMETHING TO NEWLY ARRIVED MESSAGE
'     If Msg.Subject contains like P000.0000 AND
'       folder exists that starts with P000.0000
'       then move to that folder
End If
End Sub

Answer 1

如果没有Option Explicit，错误可能是运行时错误"424"：需要对象。

使用Option Explicit，错误可能是编译错误：未定义变量。

Option Explicit
' Tools | Options | Editor tab
' Checkbox "Require Variable Declaration"
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
Dim objNS As Namespace  ' <--
Dim olFolder As folder
Dim folder As folder
Dim olFolderPrjcts As folder
Dim Msg As MailItem
Set objNS = GetNamespace("MAPI")    ' <--
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set olFolderPrjcts = olFolder.Folders("actueel")
If TypeName(Item) = "MailItem" Then
Set Msg = Item
For Each folder In olFolderPrjcts.Folders
If Left(Msg.subject, 9) = Left(folder.name, 9) Then
'Debug.Print Msg.subject
'Debug.Print folder.name
Msg.move folder ' <-- no brackets
Exit For
End If
Next
End If
End Sub