如何用Excel VBA提取Lotus Notes邮件主题写入列并解决覆盖和报错问题

• 内容覆盖问题：循环内每次都直接对Range("A:A")整列赋值，每处理一封邮件就会清空A列原有内容重写，自然只会保留最后一封邮件的主题，也不会自动向下追加。
• 类型不匹配问题：一是Lotus Notes视图导航器返回的条目可能不是文档类型（比如分类项、合计项），直接取e.Document会报错；二是部分Notes文档不存在Subject字段，或者Subject字段为空/非文本类型，直接调用nit.Text会触发类型错误。

Option Explicit

Sub Subject_Info()
    Dim NSession As Object
    Dim NMailDb As Object
    Dim v As Object
    Dim vn As Object
    Dim e As Object
    Dim doc As Object
    Dim nit As Object
    Dim View As String
    Dim Lines As Variant
    Dim nextRow As Long
    
    View = "$All"
    
    ' 初始化Notes会话
    Set NSession = CreateObject("Notes.NotesSession")
    Set NMailDb = NSession.GetDatabase("", "")
    If Not NMailDb.IsOpen Then
        NMailDb.OPENMAIL
    End If
    
    Set v = NMailDb.GetView(View)
    Set vn = v.CreateViewNav()
    Set e = vn.GetFirstDocument()
    
    ' 循环处理所有文档
    Do While Not (e Is Nothing)
        ' 先判断条目是否为文档类型，跳过分类等非文档条目
        If e.EntryType = 0 Then ' 0代表文档类型条目
            Set doc = e.Document
            Set nit = doc.GetFirstItem("subject")
            
            ' 校验Subject字段是否有有效值
            If Not nit Is Nothing And IsError(nit.Text) = False And nit.Text <> "" Then
                Lines = Split(nit.Text, vbCrLf)
                ' 定位A列第一个空白行
                nextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
                ' 写入当前邮件的主题行，不覆盖其他内容
                Range("A" & nextRow).Resize(UBound(Lines) + 1, 1).Value = Application.WorksheetFunction.Transpose(Lines)
            End If
        End If
        Set e = vn.GetNextDocument(e)
    Loop
    
    ' 释放对象
    Set nit = Nothing
    Set doc = Nothing
    Set e = Nothing
    Set vn = Nothing
    Set v = Nothing
    Set NMailDb = Nothing
    Set NSession = Nothing
End Sub

• 新增Option Explicit强制变量声明，避免未定义变量导致的隐性错误
• 新增条目类型校验，仅处理视图中的文档类型条目，跳过分类、层级项等非文档内容
• 新增Subject字段有效性校验，字段为空/无有效值时直接跳过，避免类型不匹配错误
• 新增行号定位逻辑，每次写入前先找到A列最后一个非空行的下一行，完全不会覆盖原有内容
• 新增对象释放逻辑，避免后台残留Lotus Notes进程占用资源

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