如何将表中的数据导出到电子表格中

如何将表中的数据导出到电子表格中  
   
   
   
   
  有很多方法都可将数据库中某个表的数据导出到电子表格中，例如通过创建Access.Application，可以利用Access本身的导出功能实现将表中的数据导出到电子表格中。但是这种方法会占用较多的系统资源，并且缺乏通用性。如果一个数据库没有导出的功能怎么办？下面的这段程序代码利用记录集实现导出的功能，这种做法的好处是显而易见的：你可以控制要导出的数据，而不用将整个表的内容都导出到电子表格中。为简单起见下面的程序代码仍将整个表的数据导出到电子表格中。如果你有兴趣的话，对下面的代码稍加改动就可做成更为通用的一个类或是一个控件。    
   
  首先在窗体上添加一个标签控件和一个命令按钮，然后在工程中添加对DAO引用。利用下面的程序代码就可将表中的数据导出到电子表格中。  
   
  Option   Explicit  
   
  Private   Sub   Command1_Click()  
                  Dim   tempDB   As   Database  
                  Dim   i   As   Integer                       '   循环计数器  
                  Dim   j   As   Integer  
                  Dim   rCount   As   Long                   '   记录的个数  
                  Dim   xl   As   Object                       '   OLE自动化对象  
                  Dim   Sn   As   Recordset  
                  Screen.MousePointer   =   11  
                  Label1.Caption   =   "打开数据库..."  
                  Label1.Refresh  
                  Set   tempDB   =   Workspaces(0).OpenDatabase("Nwind.mdb")  
                  Label1.Caption   =   "创建Excel对象..."  
                  Label1.Refresh  
                  Set   xl   =   CreateObject("Excel.Sheet.8")  
                  Label1.Caption   =   "创建快照型记录集..."  
                  Label1.Refresh  
                  Set   Sn   =   tempDB.OpenRecordset("Customers",   dbOpenSnapshot)  
   
                    If   Sn.RecordCount   >   0   Then  
                          Label1.Caption   =   "将字段名添加到电子表格中"  
                          Label1.Refresh  
                          For   i   =   0   To   Sn.Fields.Count   -   1  
                                  xl.Worksheets(1).cells(1,   i   +   1).Value   =   Sn(i).Name  
                          Next  
                          Sn.MoveLast  
                          Sn.MoveFirst  
                          rCount   =   Sn.RecordCount  
                          '   在记录中循环  
                          i   =   0  
                          Do   While   Not   Sn.EOF  
                                  Label1.Caption   =   "Record:"   &   Str(i   +   1)   &   "   of"   &   _  
                                  Str(rCount)  
                                  Label1.Refresh  
                                  For   j   =   0   To   Sn.Fields.Count   -   1  
                                        '   加每个字段的值加到工作表中  
                                        If   Sn(j).Type   <   11   Then  
                                              xl.Worksheets(1).cells(i   +   2,   j   +   1).Value   =   Sn(j)  
                                        Else  
                                              '   处理Memo和LongBinary   类型的字段  
                                            xl.Worksheets(1).cells(i   +   2,   j   +   1).Value   =   "Memo   or   Binary   Data"  
                                        End   If  
                                  Next   j  
                                  Sn.MoveNext  
                                  i   =   i   +   1  
                          Loop  
                          '   保存工作表  
                          Label1.Caption   =   "保存文件..."  
                          Label1.Refresh  
                          xl.SaveAs   "c:/Customers.XLS"  
                          '从内存中删除Excel对象  
                          Label1.Caption   =   "退出Excel"  
                          Label1.Refresh  
                          xl.Application.Quit  
                    Else  
                          '   没有记录  
                    End   If  
                    '   清除  
                    Label1.Caption   =   "清除对象"  
                    Label1.Refresh  
                    Set   xl   =   Nothing  
                    Set   Sn   =   Nothing  
                    Set   tempDB   =   Nothing  
                    Screen.MousePointer   =   0     '   恢复鼠标指针  
                    Label1.Caption   =   "Ready"  
                    Label1.Refresh  
               
                     
  End   Sub  
   
  Private   Sub   Form_Load()  
          Label1.AutoSize   =   True  
          Label1.Caption   =   "Ready"  
          Label1.Refresh  
  End   Sub  
  用DAO打开Excel文件  
   
  _作者:[e-mail]  
   
   
  >请问不用DATA元件,如何OPEN一个XLS档?  
  >set   db=OpenDatabase("资料库")只能开mdb,*.xls档要如何开启呢?  
  >请教高手!  
   
  Option   Explicit  
  Dim   Db   As   Database  
  Dim   Rs   As   Recordset  
   
  Private   Sub   Form_Load()  
  Set   Db   =   OpenDatabase("c:/temp/book1.xls",   False,   False,   "Excel   8.0;")  
  Set   Rs   =   Db.OpenRecordset("sheet1$")  
  End   Sub  
   
  Private   Sub   Form_Unload(Cancel   As   Integer)  
  Rs.Close  
  Db.Close  
  End   Sub  
   
  这是最简单的办法，详细的使用方法及限制请参看   VB   OnLineHelp   ，资料存取物件手册、取得外部资料、使用试算表一章。