将记录集输出到Excel模板

转载 2006年05月24日 11:46:00

'************************************************
'** 函数名称:  ExportTempletToExcel
'** 函数功能:  将记录集输出到 Excel 模板
'** 参数说明:
'**            strExcelFile         要保存的 Excel 文件
'**            strSQL               查询语句,就是要导出哪些内容
'**            strSheetName         工作表名称
'**            adoConn              已经打开的数据库连接
'** 函数返回:
'**            Boolean 类型
'**            True                 成功导出模板
'**            False                失败
'** 参考实例:
'**            Call ExportTempletToExcel(c://text.xls,查询语句,工作表1,adoConn)
'************************************************
Private Function ExportTempletToExcel(ByVal strExcelFile As String, _
                                      ByVal strSQL As String, _
                                      ByVal strSheetName As String, _
                                      ByVal adoConn As Object) As Boolean
   Dim adoRt                        As Object
   Dim lngRecordCount               As Long                       ' 记录数
   Dim intFieldCount                As Integer                    ' 字段数
   Dim strFields                    As String                     ' 所有字段名
   Dim i                            As Integer
  
   Dim exlApplication               As Object                     ' Excel 实例
   Dim exlBook                      As Object                     ' Excel 工作区
   Dim exlSheet                     As Object                     ' Excel 当前要操作的工作表

   On Error GoTo LocalErr
  
   Me.MousePointer = vbHourglass
  
   '// 创建 ADO 记录集对象
   Set adoRt = CreateObject(ADODB.Recordset)
  
   With adoRt
      .ActiveConnection = adoConn
      .CursorLocation = 3           'adUseClient
      .CursorType = 3               'adOpenStatic
      .LockType = 1                 'adLockReadOnly
      .Source = strSQL
      .Open
     
      If .EOF And .BOF Then
         ExportTempletToExcel = False
      Else
         '// 取得记录总数,+ 1 是表示还有一行字段名名称信息
         lngRecordCount = .RecordCount + 1
         intFieldCount = .Fields.Count - 1
        
         For i = 0 To intFieldCount
            '// 生成字段名信息(vbTab 在 Excel 里表示每个单元格之间的间隔)
            strFields = strFields & .Fields(i).Name & vbTab
         Next
        
         '// 去掉最后一个 vbTab 制表符
         strFields = Left$(strFields, Len(strFields) - Len(vbTab))

         '// 创建Excel实例
         Set exlApplication = CreateObject(Excel.Application)
         '// 增加一个工作区
         Set exlBook = exlApplication.Workbooks.Add
         '// 设置当前工作区为第一个工作表(默认会有3个)
         Set exlSheet = exlBook.Worksheets(1)
         '// 将第一个工作表改成指定的名称
         exlSheet.Name = strSheetName
        
         '// 清除“剪切板”
         Clipboard.Clear
         '// 将字段名称复制到“剪切板”
         Clipboard.SetText strFields
         '// 选中A1单元格
         exlSheet.Range(A1).Select
         '// 粘贴字段名称
         exlSheet.Paste

         '// 从A2开始复制记录集
         exlSheet.Range(A2).CopyFromRecordset adoRt
         '// 增加一个命名范围,作用是在导入时所需的范围
         exlApplication.Names.Add strSheetName, = & strSheetName & !$A$1:$ & _
                                  uGetColName(intFieldCount + 1) & $ & lngRecordCount
         '// 保存 Excel 文件
         exlBook.SaveAs strExcelFile
         '// 退出 Excel 实例
         exlApplication.Quit
        
         ExportTempletToExcel = True
      End If
      'adStateOpen = 1
      If .State = 1 Then
         .Close
      End If
   End With
  
LocalErr:
   '*********************************************
   '** 释放所有对象
   '*********************************************
   Set exlSheet = Nothing
   Set exlBook = Nothing
   Set exlApplication = Nothing
   Set adoRt = Nothing
   '*********************************************
  
   If Err.Number <> 0 Then
      Err.Clear
   End If
  
   Me.MousePointer = vbDefault
End Function

'// 取得列名
Private Function uGetColName(ByVal intNum As Integer) As String
   Dim strColNames                  As String
   Dim strReturn                    As String
  
   '// 通常字段数不会太多,所以到 26*3 目前已经够了。
   strColNames = A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z, & _
                 AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ, & _
                 BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ,BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ
   strReturn = Split(strColNames, ,)(intNum - 1)
   uGetColName = strReturn
End Function

 

springmvc实现导出数据信息为excle表格

1.项目增加导出日志信息 2.项目中导入poi-*.jar等操作excel文件的jar文件 poi-3.7-20120326.jar poi-excelant-3.7-2010102...
  • FiangAsDre
  • FiangAsDre
  • 2016年06月23日 10:45
  • 5702

Excel或Access,每条记录生成一份格式化的 word 文档

Word2007邮件合并自动提取数据批量制作成绩单   本例介绍如何让Word2007自动提取Excel成绩表中的数据批量制作成绩单,这个神奇的通知单自己会从Excel成绩表中提取学生的姓名、学...
  • cibiren2011
  • cibiren2011
  • 2014年05月08日 11:15
  • 3892

C#将List中的数据导入Excel文件中

上一篇描述的是C#读取XML中的数据保存到List。今天描述一下如何将List中的数据导入到Excel中。我的实现是根据下面的博客进行改进的,这里给出原来博客的内容。         由于是Excel...
  • qq_30507287
  • qq_30507287
  • 2016年12月24日 08:46
  • 1341

使用“自动化”功能将数据从ADO记录集传输到Excel

  • 2016年04月17日 23:44
  • 851KB
  • 下载

通用导出Excel数据库中的表,视图或存储过程返回记录集.rar

  • 2009年01月20日 12:23
  • 2KB
  • 下载

记录集横向显示输出即交叉表的两种方法

方法一:城市员工人数成都10深圳8北京9上海3大连6横向城市成都深圳北京上海大连员工人数108936      DataTable dtNew = new DataTable();        dt...
  • chenjiong
  • chenjiong
  • 2011年02月06日 22:39
  • 864

遍历记录集

  • 2015年08月17日 15:37
  • 8.24MB
  • 下载

记录集对象的参数

  • 2013年03月12日 10:33
  • 49KB
  • 下载

Oracle返回记录集.docx

  • 2012年06月28日 14:25
  • 53KB
  • 下载

韦东山视频纠错记录集(第一版

  • 2012年10月07日 14:22
  • 1.07MB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:将记录集输出到Excel模板
举报原因:
原因补充:

(最多只允许输入30个字)