ACCESS数据库导入EXCEL的有关问题,小弟我写的速度太慢了,大家帮小弟我看看怎样能提高速度,多谢大家

ACCESS数据库导入EXCEL的问题,我写的速度太慢了,大家帮我看看怎样能提高速度,谢谢大家
ACCESS数据库导入EXCEL的问题,我写的速度太慢了,大家帮我看看怎样能提高速度,谢谢大家.
代码如下,    
        conn.Open
        Dim   wy   As   Long
        Dim   h,a,b,j   As   Integer  

          h   =   0
        wy   =   8

        Dim   xlApp   As   Excel.Application
        Dim   xlBook   As   Excel.Workbook
        Dim   xlSheet   As   Excel.Worksheet
        Set   xlApp   =   New   Excel.Application
        Set   xlApp   =   CreateObject( "Excel.Application ")
        xlApp.Visible   =   False
        xlApp.DisplayAlerts   =   False
       
       
        Dim   Exstr   As   String                           '查询Excel表路径
        Exstr   =   App.Path
        If   Right(Exstr,   1)   <>   "\ "   Then
              Exstr   =   Exstr   +   "\ "
        End   If
       
        Exstr   =   Exstr   &   "\打印模版.xls "
       
        Set   xlBook   =   xlApp.Workbooks.Open(Exstr)
        Set   xlSheet   =   xlBook.Worksheets(1)
       

        j   =   8     '打印的第一个位置
         
                For   b   =   1   To   dpPCount   Step   1         '循环N次,要导出多个表,   dpPCount这个是变量

                          rst.Open   "select     *     from     worktable "   &   b   &   " ",   conn,   adOpenDynamic,   adLockOptimistic   '查询表
                       

                      Do   Until   rst.EOF                               '这个地方开始把数据库中的数据导入到excel中,不过速度有点....     :(
                                For   a   =   1   To   rst.Fields.Count
                                        xlSheet.Cells(j,   a)   =   rst.Fields(a   -   1)
                                Next   a
                                rst.MoveNext
                                j   =   j   +   1