Notes Excel Object Operation

Sub  Click(Source  As  Button)
     Dim  ws  As   New  NotesUIWorkspace
     Dim  uidoc  As  NotesUIDocument
     Dim  curdoc  As  NotesDocument
     Set  uidoc  =  ws.CurrentDocument
    
     Dim  db  As  NotesDatabase
     Dim  view  As  NotesView
     Dim  doc  As  NotesDocument
     Dim  session  As   New  NotesSession
     Dim  excelApplication  As  Variant
     Dim  excelWorkbook  As  Variant
     Dim  excelSheet  As  Variant
     Dim  collection  As  notesdocumentcollection 
    
     Dim  i,index1,index2  As   Integer
    
    filenames  =  ws.SaveFileDialog( False , " 导出到Excel " ,,  " D: " ,  " Report 4 Excel.xls " )
    
     If   Isempty (filenames)  Then   Exit   Sub
    
     Set  excelApplication  =   CreateObject ( " Excel.Application " )
    
    excelApplication.Visible  =   False
     Set  excelWorkbook  =  excelApplication.Workbooks.Add
     Set  excelSheet  =  excelWorkbook.Worksheets( " Sheet1 " )
    excelSheet.Range( " B2 " ).Select
    excelApplication.ActiveWindow.FreezePanes  =   True
     ' 根据选中要导出的字段来设置excle的第一列
    
    excelSheet.Cells.Font.Name  =   " Arial "
    excelSheet.Cells.Font.Size  =   10
    excelSheet.Range( " 1:1 " ).Font.Bold  =   True
    excelSheet.Range( " 1:1 " ).Interior.ColorIndex  =   15
    excelSheet.Range( " 1:1 " ).Borders.ColorIndex  =  xlAutomatic
    excelSheet.Range( " 1:1 " ).WrapText  =   True
    excelSheet.Cells.HorizontalAlignment  =   2
    
    excelSheet.Cells( 1 , 1 ).Value  =   " Item "
    excelSheet.Cells( 1 , 1 ).Interior.ColorIndex  =   6
    excelSheet.Cells( 1 , 1 ).ColumnWidth  =   3.75
    excelSheet.Cells( 1 , 1 ).RowHeight  =   26
    excelSheet.Cells( 2 , 1 ).Value  =   " SDS "
    
    excelSheet.Cells( 1 , 2 ).Value  =   " IssueType "
    excelSheet.Cells( 1 , 2 ).Font.ColorIndex  =   3
    excelSheet.Cells( 1 , 2 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 2 ).Interior.ColorIndex  =   15
    excelSheet.Cells( 1 , 2 ).ColumnWidth  =   10
    excelSheet.Cells( 1 , 2 ).AddComment( " System: "   &   Chr ( 10 )  &   " Manual Input " )
    
    excelSheet.Cells( 1 , 3 ).Value  =   " ID "
    excelSheet.Cells( 1 , 3 ).Font.ColorIndex  =   41
    excelSheet.Cells( 1 , 3 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 3 ).Interior.ColorIndex  =   15
    excelSheet.Cells( 1 , 3 ).ColumnWidth  =   10
    
    excelSheet.Cells( 1 , 4 ).Value  =   " Category "
    excelSheet.Cells( 1 , 4 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 4 ).Interior.ColorIndex  =   15
    excelSheet.Cells( 1 , 4 ).ColumnWidth  =   16
    
    excelSheet.Cells( 1 , 5 ).Value  =   " Description "
    excelSheet.Cells( 1 , 5 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 5 ).ColumnWidth  =   50
    
    excelSheet.Cells( 1 , 6 ).Value  =   " Receive "
    excelSheet.Cells( 1 , 6 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 6 ).ColumnWidth  =   20
    
    excelSheet.Cells( 1 , 7 ).Value  =   " Close "
    excelSheet.Cells( 1 , 7 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 7 ).ColumnWidth  =   20
    
    excelSheet.Cells( 1 , 8 ).Value  =   " Applicant "
    excelSheet.Cells( 1 , 8 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 8 ).ColumnWidth  =   10
    
    excelSheet.Cells( 1 , 9 ).Value  =   " Sponsor "
    excelSheet.Cells( 1 , 9 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 9 ).ColumnWidth  =   10
    
    excelSheet.Cells( 1 , 10 ).Value  =   " Status "
    excelSheet.Cells( 1 , 10 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 10 ).ColumnWidth  =   10     
    
    excelSheet.Cells( 1 , 11 ).Value  =   " Waitting Time "
    excelSheet.Cells( 1 , 11 ).Font.Bold  =   True
    excelSheet.Cells( 1 , 11 ).ColumnWidth  =   10     
    
    i  =   2  
     Set  db  =  session.CurrentDatabase
    
' 如果直接从当前视图导出
     Set  collection  =  db.UnprocessedDocuments 
     Set  doc  =  collection.GetFirstDocument()
    
     If  (doc  Is   Nothing )  Then  Messagebox( " 请选择你要导出的记录！ " )
    
     While   Not (doc  Is   Nothing )
        excelSheet.Cells(i, 3 ).Value  =  doc.Number( 0 )
        excelSheet.Cells(i, 4 ).Value  =  doc.Highlight( 0 )
        excelSheet.Cells(i, 5 ).Value  =  doc.PDescription( 0 )
        
        excelSheet.Cells(i, 6 ).Value  =  doc.Date( 0 )
        excelSheet.Cells(i, 6 ).NumberFormatLocal  =   " yyyy""/""m""/""d  上午/下午h""时""mm""分"" "
        excelSheet.Cells(i, 7 ).Value  =  doc.CloseDate( 0 )
        excelSheet.Cells(i, 7 ).NumberFormatLocal  =   " yyyy""/""m""/""d  上午/下午h""时""mm""分"" "
        
        excelSheet.Cells(i, 8 ).Value  =  doc.Creator( 0 )
        excelSheet.Cells(i, 9 ).Value  =  doc.Closer( 0 )
        excelSheet.Cells(i, 10 ).Value  =  doc.Status( 0 )    
         Dim  tIDiffrence  As   Double         
         If   Isdate (doc.CloseDate( 0 ))  =   False   Or   Isdate (doc.Date( 0 ))  =   False   Then
            excelSheet.Cells(i, 11 ).Value  =   ""
         Else
             Dim  tDTCloseDate  As   New  NotesDateTime(doc.CloseDate( 0 ))
             Dim  tDTStartDate  As   New  NotesDateTime(doc.Date( 0 ))
            
            tIDiffrence  =  tDTCloseDate.TimeDifference(tDTStartDate)
            tIDiffrence  =  tIDiffrence / ( 60 * 60 )
            excelSheet.Cells(i, 11 ).Value  =  tIDiffrence
            excelSheet.Cells(i, 11 ).NumberFormatLocal  =   " 0.00_  "
             If  tIDiffrence  >   72   Then
                excelSheet.Range( Cstr (i) & " : " & Cstr (i)).Interior.ColorIndex  =   7   '  红色
             Else
                excelSheet.Range( Cstr (i) & " : " & Cstr (i)).Interior.ColorIndex  =   35   ' 浅绿
             End   If
         End   If
         Set  doc  =  collection.GetNextDocument(doc)
        i =  i  + 1
     Wend
    
    excelWorkbook.SaveAs(filenames( 0 ))
    excelApplication.Quit
     Set  excelApplication  =   Nothing
    
    Messagebox( " 导入成功! " )
End Sub