[VBA] 实现SQLserver数据库的增删改查

[VBA] 实现 SQLserver数据库的增删改查

问题背景

用于库存管理的简单Excel系统实现，能够让库管员录入每日出入库信息并进能够按日期查询导出数据，生成简要报表，以及数据修改与删除。非科班且对VB语言和数据库语言未系统学习，有一点C语言与Python基础，有不足之处还请指教。

实现过程

数据库表单设计

出入库的数据是基于已有的Excel文件来设计的，分为出库清单与入库清单两个表，分别记录出库和入库的数据信息。表单字段结构大致如下：

入库日期	类别	规格	编码	数量	单位	备注	操作人	PC_INFO	PC_MAC	操作备注

出库日期	类别	规格	编码	入库日期	数量	单位	备注	操作人	PC_INFO	PC_MAC	操作备注

PC_INFO和 PC_MAC字段主要是通过代码获取使用者的电脑信息（MAC地址和电脑名称），操作备注是后续添加的主要用于删除记录，因为删除数据功能风险较高，所以通过在操作备注这里添加一个标志位来表示数据是"被删除"的，然后SQL语句的WHERE子句中多加入一个条件来让这部分“删除数据”不在Excel中相关表单中显示。还有一个表单是库管员姓名和密码，用于登录后进行出入库及数据修改操作，因为这个Excel工作簿中的报表还需发送给别人使用，所以添加此项专供库管员进行相关操作。

VBA 宏编写

前面说到有登录窗口和导出数据与生成报表等功能，所以是需要设计窗体和按钮的。然后再给窗体和按钮添加功能。

因为此篇文章主要是讲对数据库的增删改查实现，窗体代码此处暂不展示，主要逻辑是输入姓名与密码相匹配后点击登录按钮才会出现库管员出入库操作的表单或着相关按钮，如果各位感兴趣如何实现可评论告知，后续会单独写文如何实现窗体设计及其代码功能。

数据库连接

Public conn As ADODB.Connection 

Sub ConnDB()
    Dim ConnStr As String
    Set conn = CreateObject("ADODB.Connection")
        conn.CommandTimeout = 15 
    '定义数据库链接字符串
  	ConnStr="Provider=sqloledb;Server=yourServer;Database=yourDB;Uid=yourID;Pwd=yourPWd" 
    conn.CursorLocation = adUseClient
    conn.ConnectionString = ConnStr
    conn.Open
End Sub

定义全局变量conn是因为在多个模块和表单的代码中需要进行数据库连接来进行操作，ConnStr中的数据库连接属性需自行替换。

查询与增加数据的相关操作

先来看常用的SQL语句无非是 SELECT * FROM yourTable WHERE 入库日期 BETWEEN '2023-11-01' AND '2023-11-30'AND 入库日期 is not null 这类基本的查询语句来导出清单，复杂的汇总和报表实现我选择在SQLserver中创建存储过程再来调用，因为用VBA写长SQL会比较难编辑。

那入库日期需要如何方便别人在Excel中自行输出来查询呢？

这就需要将'2023-11-01'替换为表单对应用于更改日期的单元格，这里有点像动态SQL中一样拼接语句。

例如 : VBA 中这段代码

" strSQL = EXEC yourProcedure '" & Format(ThisWorkbook.Sheets("Sheet1").Cells(2, "I"), "yyyy-mm-dd") & "' " 其实就好比在SQLserver中的 EXEC yourProcedure @qdate (@qdate存储过程youProcedure所需的参数，此处未具体定义) 理解即可

@qdate这个参数就相当于 '" & Format(ThisWorkbook.Sheets("Sheet1").Cells(2, "I"), "yyyy-mm-dd") & "'这部分。

网上看了下 VBA 调用存储过程应该是另一种比较官方的方法，我这里没用，不知道有啥影响，目前是正常运行的。

    Set ws = ThisWorkbook.Sheets("入库")
    If ws.Cells(Rows.Count, "B").End(xlUp).Row > 2 Then
        ' 获取数据集
        Set rs = CreateObject("ADODB.Recordset")
    strSQL = " SELECT * FROM yourTable WHERE 入库日期 is not NULL "
        rs.CursorLocation = adUseClient
        rs.Open strSQL, conn, adOpenKeyset, adLockOptimistic
        For i = 3 To ws.Cells(Rows.Count, "B").End(xlUp).Row
            If ((Not IsEmpty(Cells(i, 2)) And Cells(i, 2) <> "") And _
                (Not IsEmpty(Cells(i, 3)) And Cells(i, 3) <> "") And _
                (Not IsEmpty(Cells(i, 4)) And Cells(i, 4) <> "") And _
                (Not IsEmpty(Cells(i, 5)) And Cells(i, 5) <> "")) Then
                rs.AddNew
                        rs("入库日期") = Cells(i, 2)
                        rs("xxx") = Cells(i, 3)
                        rs("yyy") = Replace(Cells(i, 4), " ", "")
                        rs("zzz") = Replace(Cells(i, 5), " ", "")
                        rs("bn") = Replace(Cells(i, 6), " ", "")
						rs("fgg") = Cells(i, 7)
                        rs("bvs") = Val(Cells(i, 8))
						rs("fgghh") = Cells(i, 9)
                        rs("kjll") = Cells(i, 10)
                        rs("bz") = Cells(i, 11)
                        rs("syjg") = Cells(i, 12)
                        rs("pc_mac") = MacInfo
                        rs("pc_name") = PCName
                        rs("操作人") = userName
                        rs("操作时间") = Now()
                rs.Update
            End If
        Next i
        rs.Close
        Set rs = Nothing
        MsgBox "入库完成!"
        Range("a3:k" & Range("b65000").End(xlUp).Row + 1).ClearContents
	End If

上面的代码for循环下面添加if条件判断是否是空值和空字符串是因为在Excel中，双击过单元格但是未输入任何内容，其实这个单元格内容就变成空字符串，库管员不小心点击空白单元格也可能会上传一大串空字符串的数据记录进数据库，出现下图这种情况。

数据修改与删除

在我这里的的删除和修改其实变成了一回事，在开头有提到过，直接给出删除的权限有一定风险，所以被要求保留修改的数据记录，这样可以知道删除之前的数据信息。

数据修改的思路是出库和入库的数据记录都有主键ID，将待修改记录的ID输入到修改界面，然后导出对应的数据，直接在单元格中编辑最后点击修改按钮实现数据修改，数据删除是在操作备注这里的下拉选框中选填上“删除数据”。然后数据库中的SQL语句加上where 操作备注 is null的条件来去除“被删除”的数据。

需要修改的数据有出库和入库两个表单，这里就在M1单元格中通过选择数据来源，然后VBA中进行条件判断在进行相关操作。

也就是在删除操作这里出现了上面更新数据一样的问题，那就是双击了操作备注列的单元格未输入任何值后点击修改，就会出现在数据库中的操作备注其实是空字符串，那么上面的where 操作备注 is null就不起作用了

此时我回过头来修改数据的UPDATE语句，使用NULLIF()函数来解决这个问题。

strSQL = " UPDATE TABLE1 SET 操作备注 = NUllIF('" & Cells(i, 14) & "','') WHERE ID = '"& Cells(i, 1) & "' "

数据修改的UPDATE语句如上，更新语句相关字段值特别长就以操作备注来举例了。

记录一下这个不断踩坑的过程。