往链点点通共享资源，了解更多请登录www.WL566
VB6.0 导出excel 方法源代码
方法一： 
用Msflexgrid的Textmatrix属性取Msflexgrid中每一个单元格的内容，然后填到Excel表中，或者写成CSV格式 
   
方法二： 
直接把查询结果导出成Excel工作表
Public  Sub  Export(formname  As  Form,  flexgridname  As  String) 
Dim  xlApp  As  Object  'Excel.Application 
Dim  xlBook  As  Object    'Excel.Workbook 
Dim  xlSheet  As  Object    'Excel.Worksheet 
          Screen.MousePointer  =  vbHourglass 
          On  Error  GoTo  Err_Proc 
          Set  xlApp  =  CreateObject("Excel.Application") 
          Set  xlBook  =  xlApp.Workbooks.Add 
          Set  xlSheet  =  xlBook.Worksheets(1) 
          'Begin  to  fill  data  to  sheet 
          Dim  i  As  Long 
          Dim  j  As  Integer 
          Dim  k  As  Integer 
          With  formname.Controls(flexgridname) 
                  For  i  =  0  To  .rows  -  1 
                          k  =  0 
                          For  j  =  0  To  .Cols  -  1 
                                  If  .colwidth(j)  >  20  Or  .colwidth(j)  <  0  Then 
                                          k  =  k  +  1 
                                          xlSheet.Cells(i  +  1,  k).Value  =  "'"  &  .TextMatrix(i,  j) 
                                  End  If 
                          Next  j 
                  Next  i 
            End  With 
            xlApp.Visible  =  True 
            Screen.MousePointer  =  vbDefault 
            Exit  Sub 
Err_Proc: 
          Screen.MousePointer  =  vbDefault 
          MsgBox  "请确认您的电脑已安装Excel！",  vbExclamation,"提示" 
           
End  Sub
===================================
Public  Function  ExporToExcel(strOpen  As  String) 
'********************************************************* 
'*  名称：ExporToExcel 
'*  功能：导出数据到EXCEL 
'*  用法：ExporToExcel(sql查询字符串) 
'********************************************************* 
          Dim  Rs_Data  As  New  ADODB.Recordset 
          Dim  Irowcount  As  Integer 
          Dim  Icolcount  As  Integer 
          Dim  cn  As  New  ADODB.Connection 
          Dim  xlApp  As  New  Excel.Application 
          Dim  xlBook  As  Excel.Workbook 
          Dim  xlSheet  As  Excel.Worksheet 
          Dim  xlQuery  As  Excel.QueryTable 
          With  Rs_Data 
                  If  .State  =  adStateOpen  Then 
                          .Close 
                  End  If 
                  .ActiveConnection  =  "provider=msdasql;DRIVER=Microsoft  Visual  FoxPro  Driver;UID=;Deleted=yes;Null=no;Collate=Machine;BackgroundFetch=no;Exclusive=No;SourceType=DBF;SourceDB=D:\DBF;" 
                  .CursorLocation  =  adUseClient 
                  .CursorType  =  adOpenStatic 
                  .Source  =  strOpen 
                  .Open 
          End  With 
          With  Rs_Data 
                  If  .RecordCount  <  1  Then 
                          MsgBox  ("没有记录!") 
                          Exit  Function 
                  End  If 
                  '记录总数 
                  Irowcount  =  .RecordCount 
                  '字段总数 
                  Icolcount  =  .Fields.Count 
          End  With 
           
          Set  xlApp  =  CreateObject("Excel.Application") 
免费平台源码资源网          Set  xlBook  =  Nothing 
          Set  xlSheet  =  Nothing 
          Set  xlBook  =  xlApp.Workbooks().Add 
          Set  xlSheet  =  xlBook.Worksheets("sheet1") 
          xlApp.Visible  =  True 
           
          '添加查询语句，导入EXCEL数据 
          Set  xlQuery  =  xlSheet.QueryTables.Add(Rs_Data,  xlSheet.Range("a1")) 
           
          xlQuery.FieldNames  =  True  '显示字段名 
          xlQuery.Refresh 
           
          xlApp.Application.Visible  =  True 
          Set  xlApp  =  Nothing    '"交还控制给Excel 
          Set  xlBook  =  Nothing 
          Set  xlSheet  =  Nothing 
           
End  Function 
==============================
'********************************************************* 

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。