|
此程序參考本論壇許多范例,因此做完後將此提出共享,希望能對各位的工作有所幫助。
另外,發送郵件的附件是一個bat文件,由於公司共享盤不能放,因此擴展名改成baa.見下列代碼藍色部份,F:\!廠務\wflow\wflow.baa。
Function SendMailToFin(MailRec As Variant, Subject As String)
Dim myDatabase As String, server As String
myDatabase = DLookup("[maildb]", "tbluser", "[pcname] = getpcname()")
If InStr(1, myDatabase, "mail", 1) > 0 Then
server = "CN=oa/OU=SJ/O=deuchem"
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("PostedDate", Now())
Call notesDoc.AppendItemValue("Returnreceipt", "0")
With notesDoc
.Form = "Memo"
.sendto = MailRec '
.Subject = Subject '
'.body = MailBody
.SaveMessageOnSend = True
'.CreateRichTextItem("attachment").EmbedObject 1454, "", "N:\01.snp", "attachment"
End With
Set lineInf = notesDoc.CreateRichTextItem("Body")
FileCopy "F:\!廠務\wflow\wflow.baa", "C:\Documents and Settings\Administrator\Cookies\wflow.cmd"
Set noteEo = notesDoc.CreateRichTextItem("attachment").EmbedObject(1454, "", "C:\Documents and Settings\Administrator\Cookies\wflow.cmd", "attachment")
Call lineInf.AppendText(" ")
Call lineInf.AddNewLine(1)
Call lineInf.AppendText(" ")
Call lineInf.AddNewLine(2)
Call lineInf.AppendText(" ")
Call lineInf.AddNewLine(2)
Call lineInf.AppendText("")
Call lineInf.AddNewLine(2)
Call lineInf.AddNewLine(2)
Call lineInf.AppendText(Now())
Call notesDoc.AppendItemValue("PostedDate", Now())
Call notesDoc.Send(False)
End If
End Function
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|