[AP] 用LotusScript實現Excel報表的自動生成和操作(寄email)

用 LotusScript 实现 Excel 报表的自动生成和操作


'//

Class ExcelReport
    Private xlApp As Variant    
    
    Sub new()
        '创建一个新的 Excel 应用实例，对应一个 Excel 文件
        Set xlApp = CreateObject("Excel.application")
        '在这个 Excel 文件当中添加一个 Sheet
        xlApp.Workbooks.Add
        xlApp.Visible = True
    End Sub    
    
    Function saveFile(strFilePath As String)
        '保存 Excel 文件到硬盘指定位置
        xlApp.ActiveWorkbook.SaveAs( strFilePath )
    End Function    
    
    Function insertData(intSheet As Integer,row As Integer,column As Integer,value As String)
        On Error Goto err_hdl
        '1.定位单元格，在第一个 Excel 文件的第 intSheet 个（从1开始）sheet 里面的
        '  行列号为 row 和 column 的单元格
        '2.用字符串 value 来填充单元格
        xlApp.Workbooks(1).Worksheets( intSheet ).Cells( row , column ).Value = value
        Exit Function        
err_hdl:        
        Print Error$ + "in cls: ExcelReport , method: insertData , at line " + Cstr( Erl )
        Exit Function
    End Function
    
    Function getData( intSheet As Integer , row As Integer , column As Integer ) As String
        On Error Goto err_hdl
        '得到第一个 Excel 文件的第 intSheet 个（从1开始）sheet 里面的行列号为 row 和 column 的单元格的值
        getData = xlApp.Workbooks(1).Worksheets( intSheet ).Cells( row , column ).Value
        Exit Function        
err_hdl:
        Print Error$ + "in cls: ExcelReport , method: getData , at line " + Cstr( Erl )
        getData = ""
        Exit Function
    End Function
    
    Function doQuit
        '关闭资源
        xlApp.Quit
        '资源释放
        Set xlApp = Nothing
    End Function    
    
End Class

'//

Sub Initialize
    
    '定义 ExcelReport 类的实例，表示一个 Excel 对象
    Dim report As ExcelReport
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim view As NotesView
    Dim doc As NotesDocument    
    Dim iRow As Integer
    Dim author As String
    
    
    
    '调用构造函数，初始化
    Set report = New ExcelReport
    
    '写入 Excel 标题行（第一行）
    Call report.insertData(1,1,1,"创建时间")
    Call report.insertData(1,1,2,"题目")
    Call report.insertData(1,1,3,"作者")    
    
    '得到按照日期排序的视图
    Set db = session.CurrentDatabase
    Set view = db.GetView("byTime")
    
    Set doc = view.GetFirstDocument
    iRow = 2
    
    While Not(doc Is Nothing)
        '按照创建日期排序，处理一周以内的所有文档
        If (doc.Created > Today-7 ) Then
            '用 Cstr 函数转换时间到字符串
            Call report.insertData(1,iRow,1,Cstr(doc.Created))
            'GetItemValue 返回的是一个字符串数组，我们要其中的第一个
            Call report.insertData(1,iRow,2,doc.GetItemValue("Subject")(0))
            '从 From 当中得到作者名字，然后转成简称
            author = doc.GetItemValue("From")(0)
            Call report.insertData(1,iRow,3,session.CreateName(author).Abbreviated)
            '找到下一个文档
            Set doc = view.GetNextDocument(doc)
            iRow = iRow + 1
        Else
            '发现不是本周内的文档，退出循环
            Goto BreakLoop
        End If
        Set doc = view.GetNextDocument(doc)
    Wend    
BreakLoop:
    
    '保存文件
    Call report.saveFile ("C:\Docs Report This Week.xls")
    '释放资源
    Call report.doQuit
    '发送邮件
    Call    SendMail("Rui R Hu/China/IBM","C:\Docs Report This Week.xls")
    '还可以发送更多地址......
    
    '删除本地文件
    Kill "C:\Docs Report This Week.xls"
End Sub

'//用email發送報表

Sub SendMail(target As String,attachment As String)
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim doc As NotesDocument
    Dim ritme As NotesRichTextItem
    
    Set db = session.CurrentDatabase
    Set doc = New NotesDocument( db )
    doc.Form = "Memo"
    doc.SendTo = target
    doc.Subject = "Here's the document you wanted"
    Set ritem = doc.CreateRichTextItem("Attachment")
    ritem.EmbedObject EMBED_ATTACHMENT, "", attachment
    Call doc.Send( False )    
End Sub

'//对齐单元格，col 表示列名称，接受 “A” “B” 等列名

Function autoFit(intSheet As Integer, col As String)
    xlApp.Workbooks(1).Worksheets(intSheet).Columns(col+":"+col).EntireColumn.AutoFit
End Function

'//自動對齊

Call report.autoFit(1,"A")
Call report.autoFit(1,"B")
Call report.autoFit(1,"C")

ex:

'//調用構造函數，初始化
Set report = New ExcelReport

'//寫入Excel標題行(第一行)
Call report.insertData(1, 1, 1, "創建時間")
Call report.insertData(1, 1, 2, "題目")
Call report.insertData(1, 1, 3, "作者")