谁能通过access调用notes发送邮件

djt

引用 Lotus Domino Object

Dim noteDb As New NotesDatabase
Dim noteSe As New NotesSession
Dim noteDc As NotesDocument
Dim noteVw As NotesView
Sub ConnectDb()
    Dim userName As String
    Dim server As String
    Dim mailDbname As String
    On Error GoTo errHand:
    'userName = noteSe.userName
    noteSe.Initialize (InputBox("password  ", , "password"))
    server = noteSe.GetEnvironmentString("MailServer", True)
    mailDbname = noteSe.GetEnvironmentString("MailFile", True)


    Set noteDb = noteSe.GetDatabase(server, mailDbname)
    Set noteVw = noteDb.getView("($Inbox)")
    Exit Sub
errHand:
    MsgBox Err.Description
End Sub
Sub SendMail()
    'Dim noteVw As NotesView
    'Dim noteDc As NotesDocument
    'Dim noteC As NotesDocumentCollection
    Dim mailDoc As NotesDocument
    Dim noteEo As NotesEmbeddedObject
   
    Dim i As Integer
    'On Error GoTo errHand:
    'For i = 0 To 2000
    If noteDb.IsOpen = False Then
        Call ConnectDb
    End If
    'Set noteVw = noteDb.getView("($Inbox)")
    '    Cells(i + 1, 1) = noteVw.Name
    'MsgBox noteVw.Name
    'Next
    'Exit Sub
    'Set noteDc = noteVw.GetLastDocument
    'MsgBox noteDc.GetItemValue("copyto")(1)
   
    'Exit Sub
    Set mailDoc = noteDb.CreateDocument()
    'Set noteEo = mailDoc.CreateRichTextItem("attachment").EmbedObject(1454, "", "d:\daxie.xla", "attachment")
    'Set noteEo = mailDoc.CreateRichTextItem("attachment")
    'mailDoc.CreateRichTextItem  '1454, "", "d:\daxie.xla", "Attach"
    mailDoc.ReplaceItemValue "Form", "Memo123"
    mailDoc.ReplaceItemValue "Subject", Cells(3, 1).Value
    mailDoc.ReplaceItemValue "Sendto", Cells(1, 1).Value
    mailDoc.ReplaceItemValue "Copyto", Cells(2, 1).Value
    Dim n As Integer
    Dim strBody As String
    n = 4
    Do Until Cells(n, 1) = ""
        strBody = strBody & Space(10) & vbCrLf & Cells(n, 1)
        n = n + 1
    Loop
    mailDoc.ReplaceItemValue "Body", strBody
    mailDoc.Send True
    mailDoc.Save True, True
    Set mailDoc = Nothing
    Exit Sub
    'Set noteDc = Nothing
    'Set noteVw = Nothing
   
errHand:
    MsgBox Err.Description
End Sub
Sub GetMail()
    'Dim noteVw As NotesView
    'Dim noteDc As NotesDocument
    Dim noteEo As NotesEmbeddedObject
   
    Dim i As Integer
    On Error GoTo errHand:
    If noteDb.IsOpen = False Then
        Call ConnectDb
    End If
    'For i = 0 To 2000
    'Set noteVw = noteDb.getView("($Inbox)")
    '    Cells(i + 1, 1) = noteVw.Name
    'MsgBox noteVw.Name
    'Next
    'Exit Sub
    Set noteDc = noteVw.GetLastDocument
    'Set noteDc = noteVw.GetPrevDocument(noteDc)
    'MsgBox noteDc.GetItemValue("copyto")(1)
    Cells(1, 1) = noteDc.Authors(0)
    Cells(2, 1) = noteDc.GetItemValue("Sendto")
    Cells(3, 1) = noteDc.GetItemValue("Copyto")
    Cells(4, 1) = noteDc.GetItemValue("Subject")
    Cells(5, 1) = noteDc.GetItemValue("Body")

    Exit Sub
errHand:
    MsgBox Err.Description
End Sub
Sub PreMail()
    'Dim noteVw As NotesView
    'Dim noteDc As NotesDocument
    Dim noteEo As NotesEmbeddedObject
   
    'Dim i As Integer
    On Error GoTo errHand:
    If noteDb.IsOpen = False Then
        Call ConnectDb
    End If
    'For i = 0 To 2000
    'Set noteVw = noteDb.getView("($Inbox)")
    '    Cells(i + 1, 1) = noteVw.Name
    'MsgBox noteVw.Name
    'Next
    'Exit Sub
    Set noteDc = noteVw.GetPrevDocument(noteDc)
    'Set noteDc = noteVw.GetPrevDocument(noteDc)
    'MsgBox noteDc.GetItemValue("copyto")(1)
    Cells(1, 1) = noteDc.Authors(0)
    Cells(2, 1) = noteDc.GetItemValue("Sendto")
    Cells(3, 1) = noteDc.GetItemValue("Copyto")
    Cells(4, 1) = noteDc.GetItemValue("Subject")
    Cells(5, 1) = noteDc.GetItemValue("Body")

    Exit

djt

dim noteDb as new NOtesDatabase
dim MailDoc as NotesDocument
dim noteEo as NotesEmbeddedObject
set MailDoc=noteDb.CreateDocument()
set noteEo=mailDoc.CreateRichTextItem("attachment").Embedobject(1454,"","C:\ceshi.xls","attachment")