用vba实现将记录集输出到Excel模板_VBA

复制代码 代码如下:

'************************************************ 
'** 函数名称:  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 

时间: 2024-10-10 11:04:19

用vba实现将记录集输出到Excel模板_VBA的相关文章

将ASP记录集输出成n列的表格形式显示的方法_应用技巧

'定义变量 Dim cn,rs,Sql Sql = "select CustomerID from Orders" '记录总数 Dim TotalNumbe Set cn = Server.CreateObject("ADODB.Connection") cn.Open "Provider=SQLOLEDB.1;User ID=sa;Initial Catalog=NorthWind;Data Source=.;Password=;" Set r

将ASP记录集输出成n列的表格形式显示的方法

'定义变量 Dim cn,rs,Sql Sql = "select CustomerID from Orders" '记录总数 Dim TotalNumbe Set cn = Server.CreateObject("ADODB.Connection") cn.Open "Provider=SQLOLEDB.1;User ID=sa;Initial Catalog=NorthWind;Data Source=.;Password=;" Set r

输出-在asp中比较记录集字段与字符串时的问题

问题描述 在asp中比较记录集字段与字符串时的问题 ' rs 是记录集 If rs("num")="1" Then Response.Write "1" End If If rs("num")=Server.HTMLEncode("1") Then Response.Write "2" End If 结果只输出 1,不输出 2.请问这是为什么,为什么第二个 If 的比较会是 False?

利用XSLT把ADO记录集转换成XML

ado|xml|记录集|转换 由于XML(可扩展标记语言:eXtensible Markup Language)真正的平台无关性,它正在逐渐成为数据传输的主要介质.XML是一种自描述的语言,数据本身就已经包含了元数据,即关于数据本身的信息.例如:"孟子E章1757281793923net_lover1807581793923"这组数据,从字面很难看出它代表什么意思,也不清楚它有几个数据段组成,但是,如果用XML来做如下的描述,我们就可以清楚地看到每个数据段所代表的含义:  <Pe

ado 记录集对象的filter属性使用中需注意的地方

ado|对象|记录集   最近使用filter对象很多,也遇到了一些问题,我会在使用过程中进一步总结,然后将重要的记录下来. 一.避免空集错误 空集错误一般在第一次filter赋值时没有匹配的情况下.例如: do while not rr.eof     rs.filter="user_id='" & rr("user_id") & "'"        do while not rs.eof                  '

将ASP纪录集输出成n列的的表格形式显示的方法

显示 前些日子有网友问:将ASP纪录集输出成n列的的表格形式显示的方法,现在写了一个,方便大家使用.'定义变量Dim cn,rs,Sql Sql = "select CustomerID from Orders" '记录总数Dim TotalNumbeSet cn = Server.CreateObject("ADODB.Connection")cn.Open "Provider=SQLOLEDB.1;User ID=sa;Initial Catalog=

将ASP纪录集输出成n列表格的方法

前些日子有网友问:将ASP纪录集输出成n列的的表格形式显示的方法,现在写了一个,方便大家使用. '定义变量 Dim cn,rs,Sql Sql = "select CustomerID from Orders" '记录总数 Dim TotalNumbe Set cn = Server.CreateObject("ADODB.Connection") cn.Open "Provider=SQLOLEDB.1;User ID=sa;Initial Catalo

PHP实现Mysql数据库连接、查询、记录集操作代码实例

在PHP网站开发中,经常需要对Mysql数据库进行操作,大体上需要经过以下几个步骤:Mysql数据库链接.Mysql数据库查询.Mysql记录集操作等,如果每次都重复上述操作,不但繁琐,而且代码冗余度高,对此我整理了部分利用PHP实现Mysql数据库操作的代码,以函数的形式贴出,可根据自行需要添加其他功能或者整合成Mysql数据库类. Mysql数据库链接代码 123456789101112 function dbConnect($hostname,$username,$pass,$db_nam

ASP 通用文章分页函数(非记录集分页)

分页|函数|记录集 说明: 本函数为文章分页, 非记录集分页本函数实现将文章分页显示, 并以指定长度显示每一分页本函数实现不需指定 URL, 自动更替 URL本函数实现返回多个结果, 为: 分页链接-文章统计信息-文章内容, 由字典实现如果分页大小大于文章总大小, 分页链接将为空. 显示如:第1页 第2页 第3页 第4页 第5页 50,000字/页 1/5页 共235,289字正文... 注: 显示内容的三个元素可自由变更位置. 附注: 如果您是在查找 记录集分页函数, 鄙人以前也写过一个, 名