分享一个自己在用的从K3数据库抓取数据写入EXCEL的模板-CSDN博客

　　今天分享一个我自己在用的VBA小程序，我自己套用这个模板，解决了不同员工不同的需求。

　　工作中，经常遇到需要从金蝶ERP中打印一些客户需要的格式的文档，还有一些内部员工自己需要的数据做分析，如果使用K3套打相对麻烦，所以一般就是用宏从K3数据库抓取数据再写入EXCEL，这样员工就能自己更新需要的数据（抓取的数据库内容基本是固定的字段，需要调整的时候不多）。

　　因为每个员工要求的结果不一样，但是操作过程都是一样的，所以，从一开始对每个人写不同的程序要求，到最后总结出来这个小模板，也是方便自己管理和维护这些小程序。下面就开始介绍这个模板是如何工作的：

　　一、建立EXCEL表格

　　如下图，这是我给所有人设计的EXCEL模板：

　　如图所示：

　　　　1、不管员工需要得到多少个表的内容，我都是会建立一个如图中1所示的工作表名，用于区分，如果有多个，就多建几个。

　　　　2、根据员工要求得到的结果，先建立一个范围，写上对应的字段名，再选中这个范围，创建一个“超级表”

　　　　3、对超级表的命名，我使用统一的格式，就是用 “表_" 加上 ”工作表名“ 的格式，这主要是为了在写VBA的过程中，让程序更方便读懂。比如这个例子中，我的工作表名是 ”出货清单FromERP“ ，那我的超级表名就叫 ”表_出货清单FromERP“ ，这个地方大家根据自己的习惯来修改就行。

　　二、代码

　　首先，我没有使用任何的其它变量，比如需要读取某个日期范围的数据，比如读取某个单据号的数据等，这些大家可以根据自己的要求添加，全部代码如下图：（后面我还会放出代码和分析用处，这里只是让大家直观看到代码其实是很少的，但它就能完成很多的工作需求）

　　下面开始讲解这段代码：

　　1、全程变量

1 Public IP As String, DB As String, UID As String, PW As String
2 Public cn As Object, rs As Object
3 Public Obj As ListObject

　　这里没什么需要特别说明的，就是一些需要用到的全程变量，有强迫症的也可以把一些非全程需要的变量自己改成局部变量。

　　2、初始化过程

 1 Sub Ini()
 2 Dim cnSQL As String
 3 
 4     IP = "你的服务器IP"
 5     DB = "你的数据库名"
 6     UID = "用于访问数据库的用户名"
 7     PW = "用户密码"
 8 
 9     Set cn = CreateObject("ADODB.Connection")
10     Set rs = CreateObject("ADODB.Recordset")
11     cnSQL = "Provider=sqloledb;Server=" & IP & ";Database=" & DB & ";Uid=" & UID & ";Pwd=" & PW & ";"
12 
13     If cn.State <> 1 Then
14         cn.Open cnSQL
15     End If
16    
17 End Sub

　　这里也没什么好介绍的，直接套用就行，这段代码我也是网上抄的。

　　3、主过程

 1 Sub Process()
 2 Dim StrSql As String
 3     
 4     '----调用变量初始化
 5     Call Ini
 6 
 7     '------从导出最新的采购价格。
 8     StrSql = "这里写你读取SQL的语句"
 9     Call ReadFromSQL("出货清单FromERP", "表_出货清单FromERP", StrSql)
10 
11     cn.Close                 '关闭连接
12     Set rs = Nothing         '清空对象
13     Set cn = Nothing         '清空对象
14     
15 End Sub

　　这里就是我们运行宏的时候执行的过程，它先调用了前面的初始化过程，然后需要你把SQL语句放进去，再调用一个读取SQL并写入EXCEL的过程，最后关闭连接，清空对象。

　　这里的关键其实就是在第8行：StrSql = "这里写你读取SQL的语句"

　　这个SQL语句呢，我们可以在相应的读取SQL的软件里调试，并根据你的要求能得到你要的结果，最后就把那一句SQL语句放在上面的双引号里就行。

　　这里提示一下，有时候SQL语句会很长很长，那没关系，我们可以把SQL语句拆分成多个字符串再连接起来就行，比如写成这样

1 StrSql="字符串1" & _
2        "字符串2" & _
3        "字符串3" & _
4        ……
5        "字符串n"

　　比如我就曾经写过一个8行的字符串，它需要通过很多个表关联查询并出一个结果，大概内容如下图：

　　第9行这里，大家就可以一目了然了，过程引用中，变量的排列为：工作表名，超级表名，SQL字符串。

　　4、从SQL读取数据，并写入EXCEL

 1 Sub ReadFromSQL(ShtName As String, objName As String, SQLStr As String)
 2 
 3     '----选择目标表
 4     Sheets(ShtName).Select
 5     
 6     '----清除原来数据
 7     With Sheets(ShtName).ListObjects(objName)
 8     
 9         '----判断当前表格是否在筛选状态，如果是，就显示所有数据，如果不做这一步，在筛选状态下，下一步操作删除的时候会出错
10         If .AutoFilter.FilterMode = True Then
11             .AutoFilter.ShowAllData
12         End If
13     
14         '----如果目标表有内容，就清空
15         If .ListRows.Count <> 0 Then
16             .DataBodyRange.Select
17             Selection.Delete
18         End If
19        
20        '----读取SQL查询结果到Records记录集
21         rs.Open SQLStr, cn
22         
23         If rs.EOF = True Then
24             'MsgBox "这里可以根据需要自己写出错提示"
25         Else
26             '下面的循环把查询结果写到Excel表中
27             .Range(2, 1).CopyFromRecordset rs
28         End If
29     
30     End With
31     
32     '----关闭记录集
33     rs.Close
34 
35 End Sub

　　第4行：我们要确定我们会转到需要写入数据的工作表，所以先定位好工作表

　　第7-30行：通过控制超级表，来清除数据。这也里讲一下为什么要用超级表，因为使用超级表，在定位、清除数据、写入数据等，它会相应的更加灵活。

　　第10-12行：这一步很关键。因为在实际使用过程中，用户有可能会把一个结果筛选，如果不加这一步，在筛选状态进行一些VBA操作，会提示出错，所以就强制的，把超级表的筛选状态变成未筛选。

　　第15-18行：这里是判断，如果这个超级表不为空，那就清空它。

　　第21行：把我们要的SQL语句对应的结果读取出来。

　　第23-28行：把SQl查询结果，写在超级表的表体区域：.Range(2,1) 位置。

　　第33行：关闭记录集。这里说一下，为什么要把这一个操作放在这，因为我们有可能会同时对多个工作表进行操作，每一个操作都会调用一次这一个过程，所以就需要在下一个调用前，把当前的记录集关闭。

　　到这里，就全部介绍结束了。

　　下面给大家看一个例子，如下图：

　　如图所示，我同时需要对多个工作表进行数据写入，所以我就套用了上面的模板，这样代码一目了然，而且细心的你可能会发现，为什么我的超级表会以 "表_" 开头，因为我这里直接使用的都是变量了。

　　还有一个，可能你还发现我多了两个变量：StartRow 和 StartCol 。这两个是放在过程：ReadFromSQL中第27行：Range(StartRow,StartCol) 的，因为我可能同时读取了两个SQL语句，但是放在同一个超级表的不同位置。

　　另外，如果你的EXCEL表还包含了一些其它的内容，并且带有公式的，那么我建立在执行VBA的时候，可以在一开始关闭“自动重算”功能，等执行完VBA后，再重新开启“自动重算”，就象上我面截图中的 “AutoCalNo” 和 “AutoCalYes”，这样运行速度有明显提升。代码如下：

1 Sub AutoCalNo()
2     Application.Calculation = xlCalculationManual       '使用手动重算
3 End Sub
4 Sub AutoCalYes()
5     Application.Calculation = xlCalculationAutomatic    '使用自动重算
6 End Sub