—

作者:

siteadmin

分類: 8.5.3, AI, AI 自動化, domino, hcl, hcl domino, LotusScript, Notes, 程式設計, 程式語言

在企業 Notes/Domino 環境中，郵件的 Recipients 欄位可能會出現多餘字串或錯誤輸入，例如：

CN=mark/O=HQ @ test
CN=mark/O=HQ@test

同時也可能會有合法的網域：

mark@testcorp.com
mark@test.com

本教學示範如何建立 Domino 代理程式，自動清理 Recipients 欄位中 獨立出現的 @test 字樣（大小寫不拘），
且避免誤刪正常網域，例如 @testcorp.com。

Part 1：Before New Mail Arrives（郵件進信箱前即時清理）

適用情境：
當你需要「一有郵件進來就立即清理 Recipients」，而不是等郵件存入信箱後再處理。

此代理程式會在郵件被寫入信箱之前直接修改 Recipients 欄位。

🧩 功能說明

去除獨立出現的 @test
不分大小寫（@Test, @TEST 也會被處理）
修正常見錯誤空格（@ test、 @ test）
不會清除正常網域（如 @testcorp.com）
支援多值 Recipients 欄位

🧑‍💻 程式碼範例（Before new mail arrives）

Option Declare

' 清理 Recipients：僅移除獨立的 @test，不影響 @testcorp.com 等網域
Function CleanRecipient(ByVal s As String) As String
    Dim t As String, lowerT As String, pos As Long, nextChar As String
    
    t = Trim$(s)
    ' 修正常見空格錯誤
    t = Replace(t, " @ ", "@")
    t = Replace(t, "@ ", "@")
    t = Replace(t, " @", "@")
    
    lowerT = Lcase$(t)
    
    Do
        pos = Instr(lowerT, "@test")
        If pos = 0 Then Exit Do
        
        ' 取得 @test 後的字元
        If pos + Len("@test") <= Len(lowerT) Then
            nextChar = Mid$(lowerT, pos + Len("@test"), 1)
        Else
            nextChar = ""   ' 結尾
        End If
        
        ' 若後面是 . 則屬正常網域 → 保留
        If nextChar = "" Or nextChar = " " Or nextChar = Chr$(10) Or nextChar = Chr$(13) Then
            t = Left$(t, pos - 1)
            lowerT = Lcase$(t)
        Else
            Exit Do
        End If
    Loop
    
    CleanRecipient = Trim$(t)
End Function

Sub Initialize
    Dim session As New NotesSession
    Dim doc As NotesDocument
    Dim recips As Variant
    Dim cleaned() As String
    Dim i As Integer, count As Integer
    Dim sVal As String
    
    Set doc = session.DocumentContext   ' ⚡ 新郵件文件
    
    If doc Is Nothing Then Exit Sub
    If Not doc.HasItem("Recipients") Then Exit Sub
    
    recips = doc.GetItemValue("Recipients")
    count = 0
    
    For i = Lbound(recips) To Ubound(recips)
        sVal = Trim$(Cstr(recips(i)))
        If sVal <> "" Then
            sVal = CleanRecipient(sVal)
            If sVal <> "" Then
                ReDim Preserve cleaned(0 To count)
                cleaned(count) = sVal
                count = count + 1
            End If
        End If
    Next
    
    If count > 0 Then
        Call doc.ReplaceItemValue("Recipients", cleaned)
    Else
        Call doc.RemoveItem("Recipients")
    End If
End Sub

設定流程（Before new mail arrives）

打開郵件資料庫（mail file）
建立 Agent：
- Trigger → Before new mail arrives
- Run → LotusScript
貼上程式碼
啟用代理程式
寄測試信 → 確認 Recipients 已被即時清理

✨ Part 2：After New Mail Arrives（郵件送達後批次清理）

適用情境：
公司政策不允許 Before New Mail Arrives，或郵件已存入信箱才要清理。

這個版本會逐筆處理 UnprocessedDocuments（未處理郵件），常用於批次清理。

Option Declare

Function CleanRecipient(ByVal s As String) As String
    Dim t As String, lowerT As String, pos As Long, nextChar As String
    
    t = Trim$(s)
    t = Replace(t, " @ ", "@")
    t = Replace(t, "@ ", "@")
    t = Replace(t, " @", "@")
    
    lowerT = Lcase$(t)
    
    Do
        pos = Instr(lowerT, "@test")
        If pos = 0 Then Exit Do
        
        If pos + Len("@test") <= Len(lowerT) Then
            nextChar = Mid$(lowerT, pos + Len("@test"), 1)
        Else
            nextChar = ""
        End If
        
        If nextChar = "" Or nextChar = " " Or nextChar = Chr$(10) Or nextChar = Chr$(13) Then
            t = Left$(t, pos - 1)
            lowerT = Lcase$(t)
        Else
            Exit Do
        End If
    Loop
    
    CleanRecipient = Trim$(t)
End Function

Sub Initialize
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim col As NotesDocumentCollection
    Dim doc As NotesDocument
    Dim recips As Variant
    Dim cleaned() As String
    Dim i As Integer, count As Integer
    Dim sVal As String

    Set db = session.CurrentDatabase
    Set col = db.UnprocessedDocuments

    Set doc = col.GetFirstDocument
    While Not doc Is Nothing
        
        If doc.HasItem("Recipients") Then
            recips = doc.GetItemValue("Recipients")
            count = 0
            
            For i = Lbound(recips) To Ubound(recips)
                sVal = Trim$(Cstr(recips(i)))
                If sVal <> "" Then
                    sVal = CleanRecipient(sVal)
                    If sVal <> "" Then
                        ReDim Preserve cleaned(0 To count)
                        cleaned(count) = sVal
                        count = count + 1
                    End If
                End If
            Next
            
            If count > 0 Then
                Call doc.ReplaceItemValue("Recipients", cleaned)
            Else
                Call doc.RemoveItem("Recipients")
            End If
            Call doc.Save(True, False)
        End If
        
        Set doc = col.GetNextDocument(doc)
    Wend
End Sub

設定流程（After new mail arrives）

建立 Agent：
- Trigger → After new mail has arrived 或定時排程
- Run → LotusScript
貼上程式碼
啟用後即可自動批次處理新郵件

完成！

你現在擁有兩種版本：

版本	優點	使用情境
Before new mail arrives	郵件進信箱前即時清理	企業允許 before-agent
After new mail arrives	可做批次、排程處理	有政策限制或想定時清理