c/s下将视图导出到excel

Sub Click(Source As Button)
   
    On Error Goto ErrorHandle
   
    Dim workspace As New NotesUIWorkspace
    Dim Session As New NotesSession
    Dim uidoc As notesuidocument   
    Dim db As NotesDatabase
    Dim view As notesview
    Dim viewt5sub As NotesView
    Dim dc As NotesDocumentCollection
    Dim dcKzd As NotesDocumentCollection
    Dim doc As notesdocument
    Dim docKzd As notesdocument
    Dim profile As notesdocument
    Dim item As notesitem
    Dim itema As notesitem
    Dim rtitem As Variant
   
    Set db = session.CurrentDatabase
    Set uidoc = workspace.CurrentDocument   
    Set doc = uidoc.Document   
   
    Set viewt5sub = db.GetView("ExportT5")
    Set dc = viewt5sub.GetAllDocumentsByKey(doc.bmgwqdbdocid(0),True)
    If dc.count = 0 Then
        Msgbox "没有数据,不能执行导出！",16,"提示"
        Exit Sub
    Else
        Print "开始导出..."
        Dim floder As String
        floder = "c:/报表"   
        If Dir$(floder,16) = "" Then
            Mkdir floder
        End If       
         '------------------------------------------------------------
         '得到excel模板----------------------------------------------
        Dim dba As New NotesDatabase(db.Server,"excelmb/mb.nsf")
        Set exview = dba.GetView("Report")
        Call exview.refresh
        Set exdc = exview.GetAllDocumentsByKey("Table",True)
        If exdc.count>0 Then
            Set exdoc = exdc.getfirstdocument
            If Not exdoc Is Nothing Then
                Set rtitem = exdoc.GetFirstItem("ReportBody")
                If ( rtitem.Type = RICHTEXT ) Then
                    Forall o In rtitem.EmbeddedObjects
                        If ( o.Type = EMBED_ATTACHMENT ) Then
                            Call o.ExtractFile( "c:/Table.xls")
                        End If
                    End Forall
                End If
            End If   
        End If
         '得到excel模板----------------------------------------------
        '产生Excel文件
        Set excelApplication = CreateObject("excel.Application")       
        Set excelWorkbook = excelApplication.Workbooks.add("c:/Table.xls")
        Set excelSheet = excelWorkbook.Worksheets("Sheet1")       
        '导出文档       
        Set docKzd = dc.GetFirstDocument()
        i = 6
        While Not(docKzd Is Nothing)
           
            bumen = doc.bumen(0)
            subject = bumen
            zxrgw = doc.kzd_zrr(0)
            docflag = doc.bmgwqdbdocid(0)
            pgsjfw =  Cstr(doc.pgfw1(0))+"～"+Cstr(doc.pgfw2(0))
            fzflow = doc.showflow
           
            excelSheet.Cells(1,1).Value = docflag           
            excelSheet.Cells(2,1).Value = doc.UniversalID  
            excelSheet.Cells(1,2).Value = subject
            excelSheet.Cells(4,2).Value = zxrgw
            excelSheet.Cells(4,7).Value = pgsjfw
            excelSheet.Cells(3,3).Value = doc.YgCode(0)
           
            excelSheet.Cells(i,1).Value = docKzd.UniversalID 
            excelSheet.Cells(i,2).Value = docKzd.xzmc(0)           
            excelSheet.Cells(i,3).Value = docKzd.kzdbh(0)
            excelSheet.Cells(i,4).Value = docKzd.a_kongzhidianmin(0)
           
            excelSheet.Cells(i,5).Value = docKzd.ygzpjl(0)           
            excelSheet.Cells(i,6).Value = docKzd.qxxz(0)
            excelSheet.Cells(i,7).Value = docKzd.qxms(0)
            excelSheet.Cells(i,8).Value = docKzd.zxqxcsyy(0)
            excelSheet.Cells(i,9).Value = docKzd.sjje(0)
            excelSheet.Cells(i,10).Value = docKzd.qzyx(0)
            excelSheet.Cells(i,11).Value = docKzd.zxgjcs(0)           
            excelSheet.Cells(i,12).Value = Cstr(docKzd.wcsj(0))
            '给excel加边框
            excelSheet.cells(i,2).Borders.LineStyle   =  1
            excelSheet.cells(i,3).Borders.LineStyle   =  1
            excelSheet.cells(i,4).Borders.LineStyle   =  1
            excelSheet.cells(i,5).Borders.LineStyle   =  1
            excelSheet.cells(i,6).Borders.LineStyle   =  1
            excelSheet.cells(i,7).Borders.LineStyle   =  1
            excelSheet.cells(i,8).Borders.LineStyle   =  1
            excelSheet.cells(i,9).Borders.LineStyle   =  1
            excelSheet.cells(i,10).Borders.LineStyle   =  1
            excelSheet.cells(i,11).Borders.LineStyle   =  1
            excelSheet.cells(i,12).Borders.LineStyle   =  1
            i = i + 1
            Set docKzd = dc.GetNextDocument(docKzd)
        Wend
       
        Kill "c:/Table5.xls"
        newfilename = floder+"/"+doc.kzd_zrr(0)+"("+Cstr(Format(Now, "yyyymmddhhhmmss"))+")"
        excelworkbook.Saveas(newfilename)
       
        excelapplication.Quit
        Set excelapplication = Nothing
        Msgbox "导出成功，请在【C:/报表】文件夹下查看！"
    End If
    Exit Sub   
ErrorHandle:
    Msgbox Cstr(Erl()) + "....." + Error(),16,"提示"
    excelapplication.Quit
    Set excelapplication = Nothing
    Exit Sub   
End Sub