前面两节我们演示了从金蝶K3数据库中提取客户和供应商资料，细心的同学会发现在提取客户资料和供应商资料时的代码基本上相同，唯一不同的地方如下：
客户资料：
供应商资料：
实际上金蝶K3系统的客户和供应商资料存储在不同的表中，同样，只要我们知道了部门、职员、仓库、商品等核算项目所在的表，就可以直接提取数据到excel。
在数据库中有一个名称为t_ItemClass的表，其中保存着核算项目类别的资料：
最后列就是核算项目对应的表名
这节我们的目的是在一个工作表中显示所有的核算项目。
思路：在B1单元格中利用数据有效性来选择要显示的核算项目类别，第2行做为分隔行，第3行显示核算项目标题，从第4行开始显示核算项目数据。为了方便，冻结前3行。
在原来的代码上我们做如下的改动：
1.如果B1单元格内容被用户删除，程序应该退出，所以有程序开始做判断：
2.在填充标题时，由于不同核算项目类别需要显示的标题不同，所以我们需要根据核算类别来判断：
3.有提取数据时，也需要根据核算项目类别来确定提取数据的字符串：
4.在程序的最后，考虑到提取的数据可能有很多，最后加上自动筛选：
代码录入结束后，先在B1单元格中选择要显示的核算项目，然后点击右侧的按钮，即可得到该核算项目的资料。
以上就是从金蝶K3数据库中提取核算项目的方法，各位有什么想法可以在评论区中留言，
最后附上源代码：
Option Explicit
Private Sub CommandButton1_Click()
Dim ado As Object
Dim rst As Object
Dim str As String
Dim sql As String
Dim dbIP As String
Dim dbsa As String
Dim dbpwd As String
Dim dbname As String
'清屏
Range("3:" & Rows.Count).Clear
'如果没有选择核算项目，退出
If Range("B1") = "" Then Exit Sub
'如果有自动筛选，先取消自动筛选
If ActiveSheet.AutoFilterMode Then Range("A3").AutoFilter
'设置表头，根据核算项目类别不同，显示不同的标题
Select Case Range("B1")
Case "客户", "供应商"
Range("A3:G3") = Array("代码", "名称", "地址", "电话", "传真", "银行", "联系人")
Case "部门", "职员", "仓库"
Range("A3:B3") = Array("代码", "名称")
Case "物料"
Range("A3:C3") = Array("代码", "名称", "规格")
End Select
'设置数据库连接字符串
dbIP = "(local)" '安装数据库的电脑IP地址，(local)代表本机
dbsa = "sa" 'SQLServer数据库的登录用户名
dbpwd = "123456" 'SQLServer数据库的登录密码
dbname = "AIS20210318095953" '需要提取数据的金蝶数据库名
str = "Provider=SQLOLEDB.1;"
str = str & "Data Source=" & dbIP & ";"
str = str & "Persist Security Info=True;"
str = str & "User ID=" & dbsa & ";"
str = str & "Password=" & dbpwd & ";"
str = str & "Initial Catalog=" & dbname & ";"
'建立数据库连接
Set ado = CreateObject("ADODB.Connection")
ado.Open str
'从指定表头提取数据并返回到工作表，根据选择的核算项目类别显示不同的内容
Select Case Range("B1")
Case "客户"
sql = "select FNumber,FName,FAddress,FPhone,FFax,FBank,FContact from t_Organization "
Case "供应商"
sql = "select FNumber,FName,FAddress,FPhone,FFax,FBank,FContact from t_Supplier "
Case "部门"
sql = "select FNumber,FName from t_Department "
Case "职员"
sql = "select FNumber,FName from t_Emp "
Case "仓库"
sql = "select FNumber,FName from t_Stock "
Case "物料"
sql = "select FNumber,FName,FModel from t_ICItem "
End Select
sql = sql & "Order By FNumber"
Set rst = ado.Execute(sql)
If Not rst.EOF Then Range("A4").CopyFromRecordset rst
rst.Close
Set rst = Nothing
Set ado = Nothing
'提取数据后加上自动筛选
Range("A3").Resize(1, Range("A3").End(xlToRight).Column).AutoFilter
End Sub
