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

代码如下:

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

(0)

相关推荐

  • excel vba 高亮显示当前行代码

    代码: 复制代码 代码如下: Private Sub Worksheet_SelectionChange(ByVal Target As Range) ThisWorkbook.Names.Add "XM", Target End Sub 这几行代码的作用是,当选择新的单元格时,将这个单元格(或者区域)定义为名称"XM",在条件格式设置中可以引用这个名称. 如下面的附件,将代码粘贴完成后,返回工作表中,选择A4:I15,点击菜单"格式-条件格式"

  • Excel VBA连接并操作Oracle

    以下是通过Excel 的VBA连接Oracle并操作Oracle相关数据的示例Excel 通过VBA连接数据库需要安装相应的Oracle客户端工具并引用ADO的相关组件,引用ADO相关组件可按如下步骤操作: 1.打开VBA编辑器,在菜单中点选"工具","引用": 2.确保"Microsoft ActiviteX Data Objects 2.8 Library"和"Microsoft ActiviteX Data ObjectS Rec

  • php 备份数据库代码(生成word,excel,json,xml,sql)

    单表备份代码: 复制代码 代码如下: <?php    class Db    {        var $conn; function Db($host="localhost",$user="root",$pass="root",$db="test")        {          if(!$this->conn=mysql_connect($host,$user,$pass))          die(

  • Node.js实现Excel转JSON

    一直在做一个关于网上选课的系统,选用了时下比较流行的node.js.今天在想怎么把学生或者老师的信息导入进去,涉及数量比较多一点,我手边又正好有一部分excel的表格.就想把excel转成json然后倒入到mongodb中去. 搜了下网上的资料,有不少.大部分都是C#或python的,要吗自己编译,要吗各种缺库运行不了.google了一下发现居然node里面是有这个module的.网址是https://www.npmjs.com/package/xls-to-json.. 步骤的话大概记录下吧:

  • excel vba 限制工作表的滚动区域代码

    ScrollArea属性使用以A1样式的区域引用形式(字符串类型)返回或设置工作表允许滚动的区域.当设置了工作表滚动区域之后,用户不能选定滚动区域之外的单元格,但仍然可以选定区域之外的其他对象(例如图形.按钮等),同时工作表的一些相应功能可能被禁止(例如工作表全选.选中整行或整列等). 在VBE中的工程管理窗口选择相应工作表对象,然后在其属性窗口中设置ScrollArea属性,即可限制工作表中滚动的区域,如图所示. 但是Excel不会记忆该项设置,当再次打开该工作簿时,ScrollArea属性将

  • VBA将excel数据表生成JSON文件

    ADODB.Stream创建UTF-8+BOM编码的文本文件. 然后遍历数据区,格式化数据,输出即可. 小数据还行,大数据没测试. 另,使用fso创建的文本文件编码为ANSI,ajax解析json时出现乱码无法正常解析. Sub ToJson() '创建UTF8文本文件 myrange = Worksheets("sheet1").UsedRange '通过有效数据区来选择数据 'myrange = ActiveWorkbook.Names("schoolinfo"

  • VBA中操作Excel常用方法总结

    要用VBA来关闭工作簿,用Workbook.Close 方法即可,而要退出Excel,则用Application.Quit 方法. 下面是一些代码示例: 关闭活动工作簿,如果工作簿有更改,提示是否保存: 复制代码 代码如下: Sub CloseWorkbook()     ActiveWorkbook.Close     End Sub 如果要避免出现提示,可添加"SaveChanges"参数,如直接保存并关闭工作簿: 复制代码 代码如下: Sub ClostAndSaveWorkbo

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

    复制代码 代码如下: '************************************************  '** 函数名称:  ExportTempletToExcel  '** 函数功能:  将记录集输出到 Excel 模板  '** 参数说明:  '**            strExcelFile         要保存的 Excel 文件  '**            strSQL               查询语句,就是要导出哪些内容  '**         

  • 将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 sqlserver 执行存储过程返回记录集报对象关闭时不允许操作

    如果要得到返回值,需要用Command的方法. 首先说明,返回值有两种.一种是在存储过程中直接return一个值,就象C和VB的函数返回值那样:另一种是可以返回多个值,存储这些值的变量名称需要在调用参数中先行指定. 这个例子要处理多种参数,输入参数,输出参数,返回记录集以及一个直接返回值(够全了吧?) 存储过程如下: 复制代码 代码如下: use pubs GO -- 建立存储过程 create procedure sp_PubsTest -- 定义三个参数变量,注意第三个,特别标记是用于输出

  • asp中记录集对象的getrows和getstring用法分析

    GetRows 方法 将 Recordset 对象的多个记录复制到数组中. 语法 复制代码 代码如下: array = recordset.GetRows( Rows, Start, Fields ) 返回值 返回二维数组. 参数 Rows 可选,长整型表达式,指定要检索记录数.默认值为 adGetRowsRest (-1). Start 可选,字符串或长整型,计算得到在 GetRows 操作开始处的记录的书签.也可使用下列 BookmarkEnum 值. 常量 说明 AdBookmarkCur

  • VB返回记录集结果到HTML表格的方法

    本文实例讲述了VB返回记录集结果到HTML表格的方法.分享给大家供大家参考.具体实现方法如下: function ReturnHTMLTable(query) set rs = cn.Execute(query) rs.MoveFirst response.Write "<table class=""data"" cols=""" & rs.Fields.Count & """

  • 用 INNER JOIN语法联接多个表建记录集

    多表联接建立记录集是十分有用的,因为某些情况下,我们需要把数字数据类型显示为相应的文本名称,这就遇到了多表联接建立记录集的问题.比如作一个会员注册系统,共有五个表,会员信息数据表member.会员身份表MemberIdentity.会员权限表MemberLevel.会员类别表MemberSort和会员婚姻状况表Wedlock.如果想把会员注册信息全部显示出来,肯定要将这四个表连起来,否则大家看到的某些会员信息可能只是数据编号.      以会员类别表来说,在其数据表中,1代表普通会员,2代表高级

  • ASP程序中使用断开的数据记录集的代码

    因此为了节省服务器资源,应该尽可能关闭连接以释放连接所占有的资源,这种关闭记录集的连接而不关闭记录集的技术叫做断开记录集,这个记录集本身则称为断开的记录集. 下面我们就通过一个实例来说明这种技术的使用方法(NorthWind.mdb是Microsoft Access97自带的一个数据库,文件adovbs.inc可在C:\Program Files\Common Files\System\ADO下找到): 复制代码 代码如下: <% @LANGUAGE = VBScript %> <!--

  • asp下实现记录集内随机取记录的代码

    记录集内随机取记录的代码 <%  ' Moving to random record - Steven Jones' Extension If Not(记录集名称.bof and 记录集名称.eof) Then ' reset the cursor to the beginning If (记录集名称.CursorType > 0) Then 记录集名称.MoveFirst Else 记录集名称.Requery End If 记录集名称_totalrn = -1 记录集名称_totalrn =

  • ASP 游标参数详解(ASP记录集)第1/2页

    rs.open sql,conn,A,B A: ADOPenforwardonly (=0) 只读,且当前数据记录只能向下移动. ADOPenkeyset (=1) 只读,当前数据记录可自由移动. ADOpendynamic (=2) 可读写,当前数据记录可自由移动. ADOpenstatic (=3) 可读写,当前数据记录可自由移动,可看到新增记录. B: ADLockreadonly (=1) 缺省锁定类型,记录集是只读的,不能修改记录. ADLockpessimistic (=2) 悲观锁

  • 可用的ASP无重复数字随机函数, 数组实现, 并应用于随机显示记录集

    经我们站长测试可用的ASP无重复数字随机函数, 数组实现, 并应用于随机显示记录集作用: 本函数适用于随机显示小数量的随机不重复数字 本函数适用于显示小数量的随机不重复记录集 为了不影响效率, 上限超过一千, 不建议使用本函数 shawl.qiu 2006-09-06  http://blog.csdn.net/btbtd 主内容: 函数及应用函数随机显示100条记录 linenum  复制代码 代码如下: <%       dim rs, rNum       dim temp       s

随机推荐