问使用VBA从Lotus提取多个收件人电子邮件地址

EN

Public Sub Get_Notes_Email_Address()
Dim NSession As Object      'NotesSession
Dim NMailDb As Object       'NotesDatabase
Dim NDocs As Object         'NotesDocumentCollection
Dim NDoc As Object          'NotesDocument
Dim NNextDoc As Object      'NotesDocument
Dim NItem As Object         'NotesItem
Dim view As String
Dim vn As Integer
Dim filterText As String

filterText = "text to search"

Set NSession = CreateObject("Notes.NotesSession")
'Set NMailDb = NSession.CurrentDatabase
Set NMailDb = NSession.getDatabase("<SERVERNAME>", "<LOCATION>")
'MsgBox NMailDb.AllEntries()

If Not NMailDb.IsOpen Then
    NMailDb.OPENMAIL
End If

Set NDocs = NMailDb.AllDocuments 

If filterText <> "" Then
    NDocs.FTSEARCH filterText, 0
End If
'MsgBox NDocs.Count
Set NDoc = NDocs.GetFirstDocument
'MsgBox NDocs.GetFirstDocument


vn = 2
Do Until NDoc Is Nothing
    Set NNextDoc = NDocs.GetNextDocument(NDoc)
    Set NItem = NDoc.GETFIRSTITEM("Body")
    If Not NItem Is Nothing Then
   
        Cells(vn, 3) = NDoc.GETITEMVALUE("Subject")(0)
        'MsgBox prompt:=NDoc.GETITEMVALUE("CopyTo")(0), Title:="CopyTo"
        Cells(vn, 4) = NDoc.GETITEMVALUE("CopyTo")
        'MsgBox prompt:=NDoc.GETITEMVALUE("SendTo")(0), Title:="SendTo"
        Cells(vn, 5) = NDoc.GETITEMVALUE("SendTo")
        
        
        
        
    End If
    Set NDoc = NNextDoc
    vn = vn + 1
   
    
Loop
'reset all objects to null
Set NMailDb = Nothing
Set NSession = Nothing