Excel 也可以玩 REST (3)

系列文章索引

---

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

至此，后台功能全部完毕。

界面实现

下面说明前端界面的实现方式。最终的界面效果如下：

image

当用户在数据区域操作时，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

还有几个辅助的子例程，不在博文中说明。

源码

Excel-Consumes-web-API