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

fyupeng

我要做一个access程序，要把生成的各单位的数据分别通过NOTES批量发送到各单位的NOTES邮箱中，能做到吗？不用一个一个发送的。

[此贴子已经被作者于2006-4-13 22:45:04编辑过]

fyupeng

就是怎样控制Lotus notes发送邮件到指定人员的邮箱，同时附加一个文挡？请指点

wtcj

我也想知道,可否把ACCESS和OUTLOOK联系起来

给每个人发一张工资单

jiazhou

好东西，期待中

jiazhou

http://www.office-cn.net/forum.php?mod=viewthread&tid=37148&replyID=&skin=1

fyupeng

想要的是Lotus notes的，因为单位办公用的是Lotus 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

fyupeng

学习先，多谢

fyupeng

能传个实例吗？

Benjamin_luk

1.登陆NOTES密码可以通过NOTES的密码共享设置达到只要开NOTES就可以发MAIL:



Option Compare Database
Option Explicit
Function SendMailToFin(MailRec As Variant, Subject As String)
Dim myDatabase As String, Server As String

myDatabase = "mail\lub" '用户数据库
If InStr(1, myDatabase, "mail", 1) > 0 Then

Server = "GDO001N/DO" Mail 服务器

Dim notessessionobject As Object
Dim notesDb As Object
Dim notesDoc As Object, lineInf As Variant
Set notessessionobject = CreateObject("notes.notessession")
Set notesDb = notessessionobject.GetDatabase(Server, myDatabase)
If Not notesDb.IsOpen Then
MsgBox ("No Notes Database Found!")
Exit Function
End If
Set notesDoc = notesDb.CreateDocument()
Call notesDoc.AppendItemValue("ostedDate", Now())
Call notesDoc.AppendItemValue("Returnreceipt", "1")

With notesDoc
  .Form = "Memo" 'A notes document needs a form name
  .sendto = MailRec '
  .Subject = Subject '
  '.body = MailBody
  .SaveMessageOnSend = True
  .CreateRichTextItem("attachment").EmbedObject 1454, "", "N:\01.snp", "attachment"
End With
   Set lineInf = notesDoc.CreateRichTextItem("Body")
   Call lineInf.AppendText("Dear customers:")
   Call lineInf.AddNewLine(1)
   Call lineInf.AppendText("ddddd")
   Call lineInf.AddNewLine(2)
   Call lineInf.AppendText("We are sorry to inform you that can not issue the order in time for your PR#: .")
   Call lineInf.AddNewLine(2)
   Call lineInf.AppendText("")
   Call lineInf.AddNewLine(2)
   Call lineInf.AddNewLine(2)
   Call lineInf.AppendText(Now())
   Call notesDoc.AppendItemValue("ostedDate", Now())
Call notesDoc.Send(False)
End If
End Function

'向多收件人发送,用数组的方法
Function NotesSendPur()
Dim recip(25) As Variant
recip(0) = "Benjamin_lu@xxx.com"
recip(1) = "Karen_chen@xxx.com"
Call SendMailToFin(recip, "秀才")
End Function

[此贴子已经被作者于2006-4-14 13:17:19编辑过]