LOTUS/DOMINO学习笔记之邮件发送程序

本篇讲解一个图书订阅系统里的一个预定图书到期提醒的例子，就是用户可以预定书籍，到货后如果一个工作日内没有去领则自动取消您的预定。

    Dim session As New NotesSession    
    Dim db As NotesDatabase
    Dim memo As NotesDocument
    Dim view As NotesView
    Dim rtitem As NotesRichTextItem    
    Set db=session.CurrentDatabase
    Set memo=New NotesDocument (db)
    Set rtitem=New NotesRichTextItem(memo,"body")
    Dim doc As NotesDocument
    Dim doc2 As NotesDocument
    Dim colls As NotesDocumentCollection    
    Dim colls2 As NotesDocumentCollection
    Dim query As String    
    Dim query2 As String
    Dim i As Integer
    Dim BorrowName As String
    Dim eval As Variant
    Dim bdate As String
    Dim ldate As Variant    
    Dim wday As Variant
    Dim borrowavail As Integer
    query="form={$borrow} & Borrow_Status=""预定"" & Borrow_BookMailDate<>"""" & Borrow_BookMail=""发送"""
    Set colls=db.Search(query,Nothing,0)    
    If colls.count=0 Then
        Exit Sub
    End If    
    Print "进入取消提醒"
    Set doc=colls.GetFirstDocument
    While Not (doc Is Nothing)                
        bdate=doc.GetItemValue("Borrow_BookMailDate")(0)
        ldate=Evaluate("@date(@now)")
        'eval=Evaluate("@Date(@Year(@totime({2008-10-12}));@month(@totime({2008-10-12}));@day(@totime({2008-10-12})))")
        'eval=Evaluate("@totime({" & ldate & "})")
        eval=Evaluate("(@totime({" & ldate(0) & "})-@totime({" & bdate & "}))/86400")
        wday=Evaluate("@weekday(@now)")
        If eval(0)>=1 And wday(0)<7  Then '周六周天除开
            query2="form={$book} & Book_ComputerID={" & doc.GetItemValue("Borrow_ComputerID")(0) & "}"
            Set colls2=db.Search(query2,Nothing,0)
            '更新该书的可借数量
            If colls2.Count>0 Then
                Set doc2=colls2.GetFirstDocument
                '取当前可借数量
                eval=Evaluate("@texttonumber({" & doc2.GetItemValue("Book_AvailBorrow")(0) & "})")
                borrowavail=eval(0)
                '取已经预定的数量
                eval=Evaluate("@texttonumber({" & doc.GetItemValue("Borrow_Number")(0) & "})")
                borrowavail=borrowavail+eval(0)
                doc2.RemoveItem("Book_AvailBorrow")
                Call doc2.AppendItemValue("Book_AvailBorrow",borrowavail)
                If borrowavail>0 Then
                    doc2.RemoveItem("Book_Status")
                    Call doc2.AppendItemValue("Book_Status","可借")
                End If
                Call doc2.Save(True,False)
                '取消预定
                doc.RemoveItem("Borrow_Status")
                Call doc.AppendItemValue("Borrow_Status","取消预定")
                Call doc.Save(True,False)
                Print "CancelBookAlarm:取消预定" & doc.GetItemValue("Borrow_BookName")(0)
            End If
        Else
            Set memo=New NotesDocument (db)
            Set rtitem=New NotesRichTextItem(memo,"body")            
            Call rtitem.AppendText("您预定的<<" & doc.GetItemValue("Borrow_BookName")(0) & ">>书已经到了" & Chr(13) & "请尽快去管理员出领取，否则在今天将取消您的预定，谢谢")
            memo.subject="您预定的<<" & doc.GetItemValue("Borrow_BookName")(0) & ">>书已经到了"            
            eval=Evaluate("@DbLookup({};{hpserver/hwapu}:{book\\archivesmanagement.nsf};{$users};{" & doc.GetItemValue("Borrow_BorrowName")(0) & "};2)")
            Print "CancelBookAlarm:" & eval(0) & "您预定的<<" & doc.GetItemValue("Borrow_BookName")(0) & ">>书已经到了"
            Call memo.Send(False,eval(0))                
            Set memo=Nothing
            Set rtitem=Nothing    
            Print "CancelBookAlarm:取消预定再次提醒" & doc.GetItemValue("Borrow_BookName")(0)
        End If
        Set doc=colls.GetNextDocument(doc)
    Wend