Outlook VBA：基于正文关键词移动邮件遇运行时错误91求助

错误根源 #

你在secondinboxitems_ItemAdd过程里声明的olnamespace是局部变量，只写了Dim olnamespace As Outlook.NameSpace但没给它赋值——也就是没执行Set olnamespace = olapp.GetNamespace("MAPI")，所以这个变量是Nothing，调用它的Folders属性自然会触发错误91。

两种修复方案 #

方案1：在ItemAdd过程里重新初始化命名空间 #

直接在处理邮件的过程里给olnamespace赋值，完整代码如下：

Private WithEvents secondinboxitems As Outlook.Items

Sub initializesecondinboxitems()
    Dim olapp As Outlook.Application
    Dim olnamespace As Outlook.NameSpace
    Dim secondinboxfolder As Outlook.Folder

    '初始化Outlook应用和命名空间
    Set olapp = New Outlook.Application
    Set olnamespace = olapp.GetNamespace("MAPI")

    '指定第二个收件箱的文件夹
    Set secondinboxfolder = olnamespace.Folders("My Name").Folders("Inbox")

    '获取收件箱的邮件集合
    Set secondinboxitems = secondinboxfolder.Items

End Sub

Private Sub secondinboxitems_ItemAdd(ByVal Item As Object)
    Dim olapp As Outlook.Application
    Dim olnamespace As Outlook.NameSpace
    Dim keyword As String
    Dim targetFolder As Outlook.Folder

    keyword = "Keyword"

    If TypeOf Item Is Outlook.MailItem Then
        Dim body As String
        body = Item.Body

        If InStr(1, body, keyword, vbTextCompare) > 0 Then
            '重新初始化命名空间并定位目标子文件夹
            Set olapp = New Outlook.Application
            Set olnamespace = olapp.GetNamespace("MAPI")
            Set targetFolder = olnamespace.Folders("My Name").Folders("Inbox").Folders("Subfolder")
            
            '执行移动操作
            Item.Move targetFolder
        End If
    End If
End Sub

方案2：用模块级变量复用命名空间 #

把olnamespace声明成模块级变量，这样初始化时赋值后，处理邮件的过程可以直接用，不用重复初始化：

'模块级变量：整个模块内都能访问
Private WithEvents secondinboxitems As Outlook.Items
Private olnamespace As Outlook.NameSpace

Sub initializesecondinboxitems()
    Dim olapp As Outlook.Application
    Dim secondinboxfolder As Outlook.Folder

    Set olapp = New Outlook.Application
    Set olnamespace = olapp.GetNamespace("MAPI")

    Set secondinboxfolder = olnamespace.Folders("My Name").Folders("Inbox")
    Set secondinboxitems = secondinboxfolder.Items

End Sub

Private Sub secondinboxitems_ItemAdd(ByVal Item As Object)
    Dim keyword As String
    Dim targetFolder As Outlook.Folder

    keyword = "Keyword"

    If TypeOf Item Is Outlook.MailItem Then
        Dim body As String
        body = Item.Body

        If InStr(1, body, keyword, vbTextCompare) > 0 Then
            '直接用模块级的命名空间定位目标文件夹
            Set targetFolder = olnamespace.Folders("My Name").Folders("Inbox").Folders("Subfolder")
            
            Item.Move targetFolder
        End If
    End If
End Sub

额外优化小技巧 #

• 可以直接通过Item.Parent.Folders("Subfolder")获取目标文件夹（只要Subfolder是当前收件箱的直接子文件夹），不用遍历整个命名空间，更高效：

  Set targetFolder = Item.Parent.Folders("Subfolder")
  

• 加个文件夹存在性检查，避免因名称写错或文件夹不存在出问题：

  On Error Resume Next
  Set targetFolder = Item.Parent.Folders("Subfolder")
  On Error GoTo 0
  If targetFolder Is Nothing Then
      MsgBox "目标子文件夹不存在，请检查名称！", vbExclamation
      Exit Sub
  End If
  

内容的提问来源于stack exchange，提问作者Nick H