ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > E文精选 > Excel VBA > ADO关于取表名和字段名的几种方法浅析

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

作者：绿色风 分类： 时间：2022-08-17 浏览：167
楼主
xmyjk		 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

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

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

 
.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

  7.     mypath = ThisWorkbook.Path & "\数据源\"
  8.     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(adSchemaColumns)
  15.         With rst1
  16.             Do While Not .EOF
  17.                 bm = rst1!table_name
  18.                 If d.Exists(bm) = False Then
  19.                     Set d(bm) = New Dictionary
  20.                 End If
  21.                 d(bm)(CStr(rst1!COLUMN_NAME)) = 0
  22.                 .MoveNext
  23.             Loop
  24.         End With
  25.         myFile = Dir
  26.     Loop
  27.     Dim arr
  28.     arr = d.Keys
  29.     For i = 0 To UBound(arr)
  30.         'Debug.Print arr(i), Join(d(arr(i)).Keys, ","), d(arr(i)).Count
  31.     Next
  32.     Erase arr
  33.     Application.ScreenUpdating = True
  34.     Set d = Nothing
  35.     rst1.Close
  36.     Set rst1 = Nothing
  37.     cnn.Close
  38.     Set cnn = Nothing
  39. 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

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

  37.     rs.Close
  38.     Set rs = Nothing
  39.     cnn.Close
  40.     Set cnn = Nothing
  41.     Set cat = Nothing
  42.     Set tb1 = Nothing

  44.     Application.ScreenUpdating = True
  45. End Sub
还有一个做法，请大家看下图。

 
其实，用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

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

  9.     Application.ScreenUpdating = False

  11.     myFile = Dir(ThisWorkbook.Path & "\数据源\*.xls")
  12.     Do While myFile <> ""
  13.         Set cat = New adox.Catalog
  14.         cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & mypath & myFile
  15.         For Each tb In cat.Tables
  16.             With tb
  17.                 bm = CStr(.Name)
  18.                 If d.Exists(bm) = False Then
  19.                     Set d(bm) = New Dictionary
  20.                 End If
  21.                 For Each cl In .Columns
  22.                     d(bm)(cl.Name) = 0
  23.                 Next
  24.             End With
  25.         Next
  26.         myFile = Dir
  27.     Loop
  28.     Dim arr
  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 cat = Nothing
  34.     Set d = Nothing
  35.     Erase arr
  36.     Application.ScreenUpdating = True
  37. 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

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

  9.     Application.ScreenUpdating = False

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

  19.         Set tb = Nothing
  20.         myFile = Dir
  21.     Loop
  22.     'Debug.Print Join(d.Keys, ",")
  23.     Set d = Nothing
  24.     Set cat = Nothing
  25.     Application.ScreenUpdating = True
  26. End Sub

  28. Sub openschema()
  29.     Dim d As New Dictionary
  30.     Dim myFile As String, mypath As String
  31.     Dim cnn As ADODB.Connection
  32.     Dim rst1 As ADODB.Recordset

  34.     mypath = ThisWorkbook.Path & "\数据源\"
  35.     Application.ScreenUpdating = False

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

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

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

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

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

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



ADO手册.zip
ADO和ADOX获取表名以及字段名方法探讨.rar
2楼
亡者天下		 过来学习一下
3楼
bluexuemei		 d(bm)(CStr(rst1!COLUMN_NAME)) ,这句d(bm)(列名)怎么理解?
4楼
Divenire		 正需要
5楼
yaoihih		 太好了，正好学习一下，谢谢。
6楼
yjzstar		 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
即相当于一个循环！
这是我的理解，不知道对不对！师傅在的时候帮我看下理解的对不对哦！
7楼
水星钓鱼		 研究的相当深入
8楼
lrlxxqxa
9楼
芐雨		 很详细，
10楼
335081548		 谢谢分享
11楼
lrlxxqxa
12楼
CheryBTL

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap