系列文章索引
Excel 也可以玩 REST
Excel 也可以玩 REST (2)
Excel 也可以玩 REST (3)
接下来，设计一个以 Excel 作为用户界面，通过 HTTP Request 对数据库进行 CRUD 操作的实现。我们在日常工作中，经常需要用 Excel 来记录事件和数据，比如，在项目实施的过程中，记录和跟进实施过程中的问题、任务分派等等。但如果不是专门的软件，如 Redmine ，基于 Excel 文件记录数据还是有很多不便之处的。比如版本冲突，多个人员不能同时编辑数据等等。
这个时候，用 Excel 作为前端界面，实现在线的数据输入和数据同步，不失为一个好的方式。但常规的方法中，Excel 与数据库交互，需要借助诸如 ADO 这样的数据访问模型。一般来说，每一台 PC 都需要安装相关驱动。比如，如果在 Linux 操作系统上部署 MySQL 数据库，那么通过 ADO 的数据访问数据库的话，可能采用 ODBC，需要为每一台 PC 安装 MySQL for ODBC 驱动。
但 Excel 基于 HTTP Request 的话，从理论上来说，只要有网络，就可以实现 CRUD ，达到在线输入的要求。所以在本篇中，我将介绍如何用 WinHttp COM 对象 ，借助 Http Request，实现对 MySQL 数据库的增删改查。
当然，前提是有服务器端提供的 Restful API。我在前面相关文章中，使用不同的方法实现过 Restful API，比如 Python Flask、 SAP Web Service 和 Node.js 等等，都提供了如何实现 Restful API 的说明，感兴趣的读者可以参考我的文章，或者网络上其他文章。如果是非开发人员，使用其他语言实现 Restful API 可能有一定难度。
我的相关文章链接：
- Flask 实现 Rest API
- SAP 如何提供 RESTful Web 服务？
- SAP 如何提供 RESTful Web 服务(2) - ABAP 与 JSON
- SAP 如何提供 RESTful Web 服务(3) - Rest 路径处理
- SAP Hana 数据库编程接口 - Node.js
辅助功能
Json 数据转换：Json 数据转换使用 Github 上的 VBA-Json 模块。前面的文章也介绍了使用方法。
http 请求封装。为了让阅读博文更加容易理解，这里不贴代码，请自行参考我上传的源码。对 Http Request 进行封装了四个方法：
doGet: 处理 GET 请求doPost: 处理 POST 请求doPut: 处理 PUT 请求doDelete：处理 DELETE 请求
CRUD 的请求
有了前面两个辅助功能，通过 http 请求进行增删改查也就非常简单，代码如下。服务器端用 flask 实现 Web API，代码请参考随博文所附的源码。flask 实现 web api 各位小伙伴可以参考我的博文Flask 实现 Rest API。
Option Explicit
Public Const BASE_URL As String = "http://localhost:5000"
Public Function get_employees() As HttpResponse
Dim resp As HttpResponse
resp = doGet(BASE_URL & "/employees")
get_employees = resp
End Function
Public Function create_employee(payload As String) As HttpResponse
Dim resp As HttpResponse
resp = doPost(BASE_URL & "/employees/create", payload)
create_employee = resp
End Function
Public Function modify_employee(empId As Integer, payload As String) As HttpResponse
Dim resp As HttpResponse
resp = doPut(BASE_URL & "/employees/" & empId, payload)
modify_employee = resp
End Function
Public Function delete_employee_by_id(empId As Integer) As HttpResponse
Dim resp As HttpResponse
resp = doDelete(BASE_URL & "/employees/" & empId)
delete_employee_by_id = resp
End Function
至此，后台功能全部完毕。
界面实现
下面说明前端界面的实现方式。最终的界面效果如下：
当用户在数据区域操作时，Excel 自动记录所在行的状态。用户修改数据，所在行的 A 列自动标记 M。如果点击插入新行，在现有数据下面插入一行，并且所在行的 A 列自动标记为 N。如果需要删除某行，则在 A 列的所在行输入 D。点击提交修改按钮，新增、修改和删除的记录被提交到后台数据库中。
ListObject 作为数据编辑区
Excel 提供了一个叫做 Table 的对象，与一般的数据区域 Range 不同，Table 对象在数据操作、界面自动化等多个方面都更加强大。Table 对象创建的方法，就是选定一个区域，然后 CTRL + T。Table 在 VBA 中被称作 ListObject，比操作 Range 要方便很多。因为篇幅原因，不对 ListObject做过多解释。
行项目状态的自动标记
自动标记通过 Workbook_SheetChange 事件来实现。当然，我们不能始终都触发这些事件，所以，我用一个全局变量 isRecordingChange 来记录是否要自动记录修改。
Public isRecordingChange As Boolean
Public Sub setRecordingFlag(flag As Boolean)
isRecordingChange = flag
End Sub
工作簿打开的时候，isRecordingChange 为 True:
Private Sub Workbook_Open()
setRecordingFlag True
End Sub
如果用户在数据区域 （用户可编辑的数据区域为 ListObject EmpTable ）修改了记录，自动将 A 列标记为 M:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If isRecordingChange = False Then Exit Sub
Dim cell As Range
Dim actionMarkCell As Range
For Each cell In Target.Cells
If isCellInRange(cell, SheetCRUD.ListObjects("EmpTable").DataBodyRange) Then
Set actionMarkCell = SheetCRUD.Cells(cell.row, 1)
If Len(actionMarkCell.Value) = 0 Then
Call removeWorkSheetProtection(SheetCRUD)
actionMarkCell.Value = "M"
Call setWorksheetProtection(SheetCRUD)
End If
End If
Next
End Sub
注意 isCellInRange(cell, SheetCRUD.ListObjects("EmpTable").DataBodyRange) 用于判断数据修改过的单元格是否在 EmpTable 的 DataBodyRange 范围内。isCellInRange 是一个自定义函数， 判断单元格 (cell) 是否在某一个范围 (rng) 内。代码如下：
Public Function isCellInRange(cell As Range, rng As Range) As Boolean
If rng Is Nothing Then
isCellInRange = False
Exit Function
End If
If cell Is Nothing Then
isCellInRange = False
Exit Function
End If
Dim isect As Object
Set isect = Application.Intersect(cell, rng)
If isect Is Nothing Then
isCellInRange = False
Else
isCellInRange = True
End If
End Function
如果用户点击了插入新行超链接，则自动在 A 列标记 N:
Public Sub insert_new_row()
Call setRecordingFlag(False)
Call removeWorkSheetProtection(SheetCRUD)
Dim tbl As ListObject
Set tbl = SheetCRUD.ListObjects("EmpTable")
tbl.ListRows.Add alwaysinsert:=True
tbl.Range(tbl.ListRows.Count, 1).Offset(1, -1).Value = "N"
Call setRecordingFlag(True)
Call setWorksheetProtection(SheetCRUD)
End Sub
刷新数据
当用户点击刷新 按钮，触发 RefreshData 子例程。RefreshData 过程调用 get_employees() 函数：
Public Sub RefreshData(ctrl As IRibbonControl)
Call setRecordingFlag(False)
Dim resp As HttpResponse
resp = get_employees()
If resp.Status = 200 Then
Call writeJson(resp.ResponseText, SheetCRUD)
End If
setRecordingFlag True
End Sub
如果 Http 请求的状态码为 200，将获取的 json 数据写到工作表中 (writeJson)：
Private Sub writeJson(jsonText As String, sht As Worksheet)
Dim parsedDict As Object
Set parsedDict = JsonConverter.parseJson(jsonText)("rows")
Dim tbl As ListObject
Set tbl = sht.ListObjects("EmpTable")
If Not tbl.DataBodyRange Is Nothing Then
tbl.DataBodyRange.Rows.Delete
End If
' Print headers
Dim startCell As Range
Set startCell = sht.Range("B1")
startCell.Offset(0, 0) = "雇员ID"
startCell.Offset(0, 1) = "名"
startCell.Offset(0, 2) = "姓"
startCell.Offset(0, 3) = "性别"
startCell.Offset(0, 4) = "年龄"
startCell.Offset(0, 5) = "Email"
startCell.Offset(0, 6) = "电话号码"
startCell.Offset(0, 7) = "教育程度"
startCell.Offset(0, 8) = "婚姻状况"
startCell.Offset(0, 9) = "子女数"
' Print items
Dim item As Dictionary
Dim valArray() As Variant
ReDim valArray(1 To parsedDict.Count, 1 To COL_COUNT)
Dim rowIdx As Long
rowIdx = 1
For Each item In parsedDict
valArray(rowIdx, 1) = item("EMP_ID")
valArray(rowIdx, 2) = item("FIRST_NAME")
valArray(rowIdx, 3) = item("LAST_NAME")
valArray(rowIdx, 4) = item("GENDER")
valArray(rowIdx, 5) = item("AGE")
valArray(rowIdx, 6) = item("EMAIL")
valArray(rowIdx, 7) = item("PHONE_NR")
valArray(rowIdx, 8) = item("EDUCATION")
valArray(rowIdx, 9) = item("MARITAL_STAT")
valArray(rowIdx, 10) = item("NR_OF_CHILDREN")
rowIdx = rowIdx + 1
Next
startCell.Offset(1, 0).Resize(parsedDict.Count, COL_COUNT).Value = valArray
End Sub
插入新行
用户点击插入新行超链接，插入一个新行，并且标记为 N。insert_new_row 的代码如下：
' 点击[插入记录]按钮，插入空行并标记为插入状态(N)
Public Sub InsertData(ctrl As IRibbonControl)
Call setRecordingFlag(False)
Dim tbl As ListObject
Set tbl = SheetCRUD.ListObjects("EmpTable")
tbl.ListRows.Add alwaysinsert:=True
tbl.Range(tbl.ListRows.Count, 1).Offset(1, -1).Value = "N"
Call setRecordingFlag(True)
End Sub
提交修改
如果用户点击了提交修改超链接，自动将修改的数据提交到后台：
Public Sub UpdateData(ctrl As IRibbonControl)
Dim empId As Integer
Dim tbl As ListObject
Set tbl = SheetCRUD.ListObjects("EmpTable")
' 根据 A 列确定相应的操作
' N: 新增， M: 修改, D: 删除
Dim idx As Long
Dim action As String
For idx = 1 To tbl.ListRows.Count
action = tbl.ListRows(idx).Range(1, 1).Offset(0, -1).Value
If UCase(action) = "N" Then
If str(tbl.ListRows(idx).Range(1, 1).Value) = "" Then
tbl.ListRows(idx).Range(1, 1).Offset(0, -1).Value = ""
Else
Dim newEmp As Employee
Dim payload As String
newEmp = build_employee_from_range(idx)
payload = convert_emp_to_json_text(newEmp)
Dim resp As HttpResponse
resp = create_employee(payload)
If resp.Status = 201 Then
tbl.ListRows(idx).Range(1, 1).Offset(0, -1).Value = ""
End If
End If
End If
If UCase(action) = "M" Then
Application.ScreenUpdating = False
Dim modifiedEmp As Employee
modifiedEmp = build_employee_from_range(idx)
empId = tbl.ListRows(idx).Range(1, 1).Value
payload = convert_emp_to_json_text(modifiedEmp)
Call modify_employee(empId, payload)
tbl.ListRows(idx).Range(1, 1).Offset(0, -1).Value = ""
Application.ScreenUpdating = True
End If
If UCase(action) = "D" Then
empId = tbl.ListRows(idx).Range(1, 1).Value
Call delete_employee_by_id(empId)
tbl.ListRows(idx).Range(1, 1).Offset(0, -1).Value = ""
End If
Next
If UCase(action) = "D" Then
Call Refresh_Data
End If
End Sub
还有几个辅助的子例程，不在博文中说明。
