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