Excel VBA Excel表格数据导入Access数据库/数据校验初探

☆本期内容概要☆

• Excel表格数据导入Access数据库前的数据校验

在前面一些的文章中，我有提到我在设计一个《财务管理系统》（不是近期分享的财务记账模板），有一个功能是数据导入。今天在使用的时候，想到数据检验的问题：

1、导入的Excel表的字段与Access表的字段是否一致（包括排列顺序）？

2、比如，在导入“会计凭证”的时候，检查Excel表中的会计科目是否已存在于Access数据库表？

今天花了点时间，初步实现异常数据校验功能，把过程写出来分享给大家，这是校验的结果，它列出了“不存在的字段“、”位置不同的字段“以及“不存在的数据记录”：

我们来看一下操作演示：

先说明一下背景：

1、图中的“甲有限公司（数据备份)20230423....“文件是我从这个财务管理系统中导出来的，字段名称及顺序是完全一致的。

2、然后，我把两个表中的字段名称改了一下，把【tb凭证】表中的科目代码改了两个、字段位置调换一些。

结果就如图所示，数据检验有异常，如果不做修改，应该是显示校验成功，不防再测试一下，我先导出，不做任何修改，立即做导入数据校验：

我们看一下代码（数据校验按钮）：

Private Sub CmdValidation_Click()   Dim xlcnn As Object   '数据库连接，连接excel    Dim xlrs As Object   '记录集对象    Dim xlStrCnn As String     'Excel SQL 查询连接语句    Dim xlData()    '数组，存放记录    Dim xlTitle()   '数组，存放excel表头    Dim acTitle()   '数组，存放Access表头    Dim Msg As String, strCheck As String   '存放校验结果信息    Dim arr()    '数组，存放从access中查询的校验数据    On Error Resume Next    Set xlcnn = CreateObject("ADODB.Connection")    Set xlrs = CreateObject("ADODB.Recordset")    xlStrCnn = clsGT.GetStrCnn(sFile)   '自定义函数，生成查询连接字符串    xlcnn.Open xlStrCnn    '打开连接    For Each LvItem In Me.LvSelected.ListItems  '循环选择的每一个表        CurrTable = LvItem.Text        SQL1 = " select * from  [" & CurrTable & "$]"        Set xlrs = xlcnn.Execute(SQL1)        xlData = xlrs.getrows        n = xlrs.Fields.Count - 1        ReDim xlTitle(n)        For i = 0 To n            xlTitle(i) = xlrs.Fields(i).Name        Next        sql = "select * from " & CurrTable        acTitle = clsDQ.GetFields(sql)        If UBound(acTitle) <> n Then            Msg = Msg & "【" & CurrTable & "】字段数量不一致" & Chr(10)        Else          strCheck = Join(acTitle, "/")            strCheck = "/" & strCheck & "/"            For i = 0 To n                If InStr(strCheck, xlTitle(i)) = 0 Then                    Msg = Msg & "【" & CurrTable & "】【" & xlTitle(i) & "】字段不存在" & Chr(10)                Else                    If xlTitle(i) <> acTitle(i) Then                        Msg = Msg & "【" & CurrTable & "】【" & xlTitle(i) & "<--> " & acTitle(i) & "】字段位置不同" & Chr(10)                        'Stop                    End If                End If            Next        End If        If CurrTable = "tb凭证" Then            Dim PosAccCode As Integer            arr = clsDQ.GetData("select 科目代码 from tb科目")            strCheck = Join(FlattenArray(arr), "/")            strCheck = "/" & strCheck & "/"            PosAccCode = Pxy(xlTitle, "科目代码") - 1            For k = 0 To UBound(xlData, 2)                If InStr(strCheck, xlData(PosAccCode, k)) = 0 Then                    Msg = Msg & "【" & CurrTable & "】【" & xlData(PosAccCode, k) & "】科目代码不存在" & Chr(10)                End If            Next        End If    Next    If Msg = "" Then        MsgBox "字段校验无误！"    Else        MsgBox Msg    End IfEnd Sub

简单解释一下代码：

1、定义变量

2、从用户窗体右边的listivew循环读取要校验的表名

3、把列表中的Excel表的字段名存入数组xlTitle

4、循环xlTitle，查询Access数据库中同名的表，字段存入acTitle 

5、比较xlTitle与acTitle字段的数据、名称、位置，如果有不相同的记录，把它记入Msg

6、字段比较完了，再比较相关记录，这里我们暂时就搞了一个【tb凭证】表中，科目代码是否在Access数据库的【tb科目】中存在。

7、结束比较，如果没有异常，则Msg为空，我们输出提示信息“字段校验无误“，否则，则输出Msg的内容，我们可以看到是哪里出了问题。

Excel导入Access的主要代码我放在第二条，由于时间关系，不多解释了，感兴趣的小伙伴可以自行观摩。

好，今天就分享到这。由于这个代码无法独立运行，就不提供示例文件了，大家参考思路即可，我们下期再会。

---