设为首页收藏本站|繁體中文

Excel 技巧网

 找回密码
 注册

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 10873|回复: 17

[Excel VBA] ADO关于取表名和字段名的几种方法浅析

  [复制链接]
发表于 2012-4-11 23:51:26 | 显示全部楼层 |阅读模式
  • 署名作者: xmyjk
  • 版权声明: 版权归本站与作者共有 除本站官方外非作者本人转载须经许可并注明出处
  • 本文来自:
  • 引用作品:
  • 适用版本: 2013 2010 2007 2003以前版本 
  • 语言环境: 简体中文
  • 学习方法: 掌握Excel技巧的关键是动手操作 | 下载 ≠ 知识


  • 免费注册成为本站会员,享用更多功能,结识更多Office办公高手!

    您需要 登录 才可以下载或查看,没有帐号?注册

    x
    本帖最后由 xmyjk 于 2012-4-30 00:18 编辑

    1.关于使用ADO对象的.OpenSchema方法获取表名和字段名
        几个主流社区,关于使用.OpenSchema方法获取表名和字段名的做法是,先运用.openschema(adSchemaTables),获取表名,然后进行.Execute执行SQL语句,获取Recordset,然后读取FIELDS,代码如下:
    1. Sub OPENSANDEXC()
    2.     Dim d As New Dictionary, i%
    3.     Dim myFile As String, mypath As String, bm As String
    4.     Dim cnn As ADODB.Connection
    5.     Dim rst As ADODB.Recordset, rst1 As ADODB.Recordset, lj As String
    6.     Dim fl As Field

    7.     mypath = ThisWorkbook.Path & "\数据源"
    8.     lj = " from [Excel 8.0;Database=" & mypath
    9.     Application.ScreenUpdating = False

    10.     myFile = Dir(ThisWorkbook.Path & "\数据源\*.xls")
    11.     Do While myFile <> ""
    12.         Set cnn = New ADODB.Connection
    13.         cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & mypath & myFile
    14.         Set rst1 = cnn.openschema(adSchemaTables)
    15.         Do While Not rst1.EOF
    16.             bm = rst1!table_name
    17.             Set rst = cnn.Execute("select * " & lj & myFile & "].[" & bm & "]")
    18.             If d.Exists(bm) = False Then
    19.                 Set d(bm) = New Dictionary
    20.             End If
    21.             With rst
    22.                 For Each fl In .Fields
    23.                     d(bm)(fl.Name) = 0
    24.                 Next
    25.             End With
    26.             rst1.MoveNext
    27.         Loop
    28.         myFile = Dir
    29.     Loop
    30.     Dim arr
    31.     arr = d.Keys
    32.     For i = 0 To UBound(arr)
    33.         'Debug.Print arr(i), Join(d(arr(i)).Keys, ","), d(arr(i)).Count
    34.     Next
    35.     Erase arr
    36.     Application.ScreenUpdating = True
    37.     Set d = Nothing
    38.     rst.Close
    39.     Set rst = Nothing
    40.     rst1.Close
    41.     Set rst1 = Nothing
    42.     cnn.Close
    43.     Set cnn = Nothing
    44. End Sub
    复制代码
    其实不然在,如下图,

    ADO关于取表名和字段名的几种方法浅析

    ADO关于取表名和字段名的几种方法浅析

    .openschema(adSchemaColumns)就可以获取表名以及字段名,视乎没必要用.EXECUTE。整体代码如下,可以测试附件,附件的运行为了区分度,都是让汇总程序执行了20次,运行结果体现,速度还是不错的:
    1. Sub OPENCL()
    2.     Dim d As New Dictionary, i%
    3.     Dim myFile As String, mypath As String, bm As String
    4.     Dim cnn As ADODB.Connection
    5.     Dim rst1 As ADODB.Recordset

    6.     mypath = ThisWorkbook.Path & "\数据源"
    7.     Application.ScreenUpdating = False

    8.     myFile = Dir(ThisWorkbook.Path & "\数据源\*.xls")
    9.     Do While myFile <> ""
    10.         Set cnn = New ADODB.Connection
    11.         cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & mypath & myFile
    12.         Set rst1 = cnn.openschema(adSchemaColumns)
    13.         With rst1
    14.             Do While Not .EOF
    15.                 bm = rst1!table_name
    16.                 If d.Exists(bm) = False Then
    17.                     Set d(bm) = New Dictionary
    18.                 End If
    19.                 d(bm)(CStr(rst1!COLUMN_NAME)) = 0
    20.                 .MoveNext
    21.             Loop
    22.         End With
    23.         myFile = Dir
    24.     Loop
    25.     Dim arr
    26.     arr = d.Keys
    27.     For i = 0 To UBound(arr)
    28.         'Debug.Print arr(i), Join(d(arr(i)).Keys, ","), d(arr(i)).Count
    29.     Next
    30.     Erase arr
    31.     Application.ScreenUpdating = True
    32.     Set d = Nothing
    33.     rst1.Close
    34.     Set rst1 = Nothing
    35.     cnn.Close
    36.     Set cnn = Nothing
    37. End Sub
    复制代码
    2.关于使用ADOX获取表名和字段名
         几个主流社区,都是使用ADOX进行.ActiveConnection,然后从.Tables对象集合里面去获取表名,然后再去做ADO的.Connection,然后就.exectue去获取字段名。
    1. Sub ADOXANDEXC()
    2.     Dim cnn As New ADODB.Connection
    3.     Dim rs As ADODB.Recordset
    4.     Dim d As New Dictionary
    5.     Dim cat As adox.Catalog, tb1 As Table
    6.     Dim myFile$, i&, SQL$, shn$, p$, mypath$
    7.     Dim arr

    8.     Application.ScreenUpdating = False
    9.     mypath = ThisWorkbook.Path & "\数据源"
    10.     p = "select * from [Excel 8.0;Database=" & mypath
    11.     myFile = Dir(mypath & "*.xls")
    12.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & mypath & myFile    '连接第一个工作簿
    13.     Do While myFile <> ""
    14.         Set cat = New adox.Catalog
    15.         cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & mypath & myFile    '连接工作簿以利用ADOX取得工作表名
    16.         For Each tb1 In cat.Tables
    17.             shn = tb1.Name
    18.             If Not d.Exists(shn) Then    '该工作表名字典不存在
    19.                 Set d(shn) = New Dictionary    '[字典嵌套]定义记录各工作表表头不重复项目列号字典
    20.             End If
    21.             SQL = p & myFile & "].[" & shn & "]"    '取第1行标题
    22.             Set rs = cnn.Execute(SQL)
    23.             For i = 0 To rs.Fields.Count - 1    '逐个字段
    24.                 d(shn)(rs.Fields(i).Name) = 0
    25.             Next
    26.         Next
    27.         myFile = Dir()
    28.     Loop
    29.     arr = d.Keys
    30.     For i = 0 To UBound(arr)
    31.         'Debug.Print arr(i), Join(d(arr(i)).Keys, ","), d(arr(i)).Count
    32.     Next
    33.     Set d = Nothing
    34.     Erase arr

    35.     rs.Close
    36.     Set rs = Nothing
    37.     cnn.Close
    38.     Set cnn = Nothing
    39.     Set cat = Nothing
    40.     Set tb1 = Nothing

    41.     Application.ScreenUpdating = True
    42. End Sub
    复制代码
    还有一个做法,请大家看下图。

    ADO关于取表名和字段名的几种方法浅析

    ADO关于取表名和字段名的几种方法浅析

    其实,用ADOX进行连接后,获取的.tables对象集合里面,已经包含了.columns的对象集合,这个集合是什么呢,就是我们需要的字段名。所以没必要再次建立ADO连接,然后执行sql语句去获取字段名。测试了下结果,速度上和原来execute不想上下,估计是.columns的对象集合也比较庞大,调用起来比较耗费效率。
    整体代码如下:
    1. Sub ADOXTB()
    2.     Dim cat As adox.Catalog, i%
    3.     Dim d As New Dictionary
    4.     Dim myFile As String, mypath As String, bm As String
    5.     Dim tb As Table, cl As Column

    6.     mypath = ThisWorkbook.Path & "\数据源"

    7.     Application.ScreenUpdating = False

    8.     myFile = Dir(ThisWorkbook.Path & "\数据源\*.xls")
    9.     Do While myFile <> ""
    10.         Set cat = New adox.Catalog
    11.         cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & mypath & myFile
    12.         For Each tb In cat.Tables
    13.             With tb
    14.                 bm = CStr(.Name)
    15.                 If d.Exists(bm) = False Then
    16.                     Set d(bm) = New Dictionary
    17.                 End If
    18.                 For Each cl In .Columns
    19.                     d(bm)(cl.Name) = 0
    20.                 Next
    21.             End With
    22.         Next
    23.         myFile = Dir
    24.     Loop
    25.     Dim arr
    26.     arr = d.Keys
    27.     For i = 0 To UBound(arr)
    28.         'Debug.Print arr(i), Join(d(arr(i)).Keys, ","), d(arr(i)).Count
    29.     Next
    30.     Set cat = Nothing
    31.     Set d = Nothing
    32.     Erase arr
    33.     Application.ScreenUpdating = True
    34. End Sub
    复制代码
    3.如果从单纯获取表名的方法来对比
        两种方法都能取到表名。且效率都很高,但是,用.openschema(adSchemaTables)的好处就是,后面再执行SQL语句的时候,不用再次连接,因为CNN.OPEN已经做好了,可以直接使用了。
    1. Sub adox()
    2.     Dim cat As adox.Catalog
    3.     Dim d As New Dictionary
    4.     Dim myFile As String, mypath As String
    5.     Dim tb As Table

    6.     mypath = ThisWorkbook.Path & "\数据源"

    7.     Application.ScreenUpdating = False

    8.     myFile = Dir(ThisWorkbook.Path & "\数据源\*.xls")
    9.     Do While myFile <> ""
    10.         Set cat = New adox.Catalog
    11.         cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & mypath & myFile
    12.         For Each tb In cat.Tables
    13.             d(CStr(tb.Name)) = 0
    14.         Next

    15.         Set tb = Nothing
    16.         myFile = Dir
    17.     Loop
    18.     'Debug.Print Join(d.Keys, ",")
    19.     Set d = Nothing
    20.     Set cat = Nothing
    21.     Application.ScreenUpdating = True
    22. End Sub

    23. Sub openschema()
    24.     Dim d As New Dictionary
    25.     Dim myFile As String, mypath As String
    26.     Dim cnn As ADODB.Connection
    27.     Dim rst1 As ADODB.Recordset

    28.     mypath = ThisWorkbook.Path & "\数据源"
    29.     Application.ScreenUpdating = False

    30.     myFile = Dir(ThisWorkbook.Path & "\数据源\*.xls")
    31.     Do While myFile <> ""
    32.         Set cnn = New ADODB.Connection
    33.         cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & mypath & myFile
    34.         Set rst1 = cnn.openschema(adSchemaTables)
    35.         With rst1
    36.             Do While Not .EOF
    37.                 d(CStr(rst1!table_name)) = 0
    38.                 .MoveNext
    39.             Loop
    40.         End With
    41.         myFile = Dir
    42.     Loop
    43.     'Debug.Print Join(d.Keys, ",")
    44.     rst1.Close
    45.     cnn.Close
    46.     Set rst1 = Nothing
    47.     Set cnn = Nothing
    48.     Application.ScreenUpdating = True
    49.     Set d = Nothing
    50. End Sub
    51.    
    复制代码
    附件上传了,大家都可以试看看,四个方式的比较。

        最后,第1点和第2点的取表头方式,都和传统的FIELDS集合中取的表头的顺序不同(即与原表表头不同),因为系统有进行了排序,因此,实践操作中,可以先把关键字段放入字典,后续循环的时候,排除该关键字即可,如果是很乱序的多表表头,应该不会有什么影响。

        还是比较推荐用.openschema(adSchemaColumns)方式取获取不同字段多表表头的,效率很高,且与表的链接已经做好了,下一步如果要执行什么SQL代码,也可以直接用。

        总之,存在即合理,微软设计了ADOX对象来针对数据结构的操作,肯定是有独到的地方的,虽然表现出来ADOX的效率貌似那么不尽人意,但是他还有很多其他功能值得我们去探究的。

        VBA的世界真的很广,随便研究下都能研究出很多的。呵呵呵。最后上传一下找到的一个ADO和ADOX对象的完全手册,有兴趣的同志,也可以下载研究下。

        对了,最最最后,分享下ADO一个学习资料的网址,里面还有很多方法事件对象的示例。http://doc.51windows.net/ado/?url=/ado/mdmthopenschema.htm。另外只是方法讨论,代码还没考虑楼楼上那些表名判断的问题。
       
        最后,请各位高手多多指正。谢谢。


    ADO手册.zip

    783.16 KB, 下载次数: 279, 下载积分: 消费券 -5 Ti币

    ADO关于取表名和字段名的几种方法浅析

    ADO和ADOX获取表名以及字段名方法探讨.rar

    165.3 KB, 下载次数: 133, 下载积分: 消费券 -5 Ti币

    ADO关于取表名和字段名的几种方法浅析

    评分

    参与人数 2魅力值 +10 消费券 +50 收起 理由
    CheryBTL + 5 + 50 膜拜师傅大作!
    Divenire + 5 非常有帮助

    查看全部评分

    发表于 2012-4-21 15:05:30 | 显示全部楼层
    本帖最后由 bluexuemei 于 2012-4-21 15:05 编辑

    d(bm)(CStr(rst1!COLUMN_NAME)) ,这句d(bm)(列名)怎么理解?

    点评

    d(bm)(CStr(rst1!COLUMN_NAME)) d(bm)是一个单独的字段集 (列名)即是d(bm)的关键字,其关键字的添加通过d(bm)(CStr(rst1!COLUMN_NAME)) =0来实现 其实关键在于rst1!COLUMN_NAME,它其实是遍历了当前工作表中的所  详情 回复 发表于 2013-7-29 13:04
    回复 支持 反对

    使用道具 举报

    发表于 2012-12-15 00:19:25 | 显示全部楼层
    正需要
    回复 支持 反对

    使用道具 举报

    发表于 2013-3-6 16:51:44 | 显示全部楼层
    太好了,正好学习一下,谢谢。
    回复 支持 反对

    使用道具 举报

    发表于 2013-7-29 13:04:22 | 显示全部楼层
    本帖最后由 yjzstar 于 2013-7-29 13:04 编辑


    d(bm)(CStr(rst1!COLUMN_NAME))
    d(bm)是一个单独的字典集
    (列名)即是d(bm)的关键字,其关键字的添加通过d(bm)(CStr(rst1!COLUMN_NAME)) =0来实现
    其实关键在于rst1!COLUMN_NAME,它其实是遍历了当前工作表中的所有字段,同样rst1!table_name
    一样,它是遍历了工作表中的每个工作表,rst1!COLUMN_NAME相当于是第一部分代码中的:
    1. For Each fl In .Fields
    2.                     d(bm)(fl.Name) = 0
    3.                 Next
    复制代码
    即相当于一个循环!
    这是我的理解,不知道对不对!师傅在的时候帮我看下理解的对不对哦!
    回复 支持 反对

    使用道具 举报

    发表于 2013-12-19 14:36:50 | 显示全部楼层
    研究的相当深入
    回复 支持 反对

    使用道具 举报

    发表于 2014-1-5 23:06:47 | 显示全部楼层
    回复

    使用道具 举报

    发表于 2014-1-6 08:43:13 | 显示全部楼层
    很详细,
    回复

    使用道具 举报

    发表于 2014-1-6 09:26:10 | 显示全部楼层
    谢谢分享
    回复

    使用道具 举报

    发表于 2014-1-7 07:06:56 | 显示全部楼层
    回复

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    Excel技巧网的会员探讨问题仅代表其个人意见,与网站的立场无关。任何违反国家和地方相关法律法规的言论,本站有义务协助政府相关部门追究发言者的责任!
    本站中非注明转载文章与案例的版权为作者与Excel技巧网共有。若非原文作者,本站之外任何单位或个人未经允许,不得将其用于商业用途。
    若非原文作者,任何形式的非商业性转载必须获得Excel技巧网或作者允许,并注明作者和出处。
    会员发表的帖子如涉及版权纠纷,须自行负责。详情请参考注册时的网站服务条款。
    本站特聘法律顾问:沈学律师

    Archiver|手机版|Excel技巧网 ( 闽ICP备08107682号-2 ) | 闽公网安备 35020302032608号  

    GMT+8, 2018-10-16 20:48

    Powered by Discuz! X3.3

    © 2001-2017 Comsenz Inc.

    快速回复 返回顶部 返回列表