基于Excel VBA从患者数据生成FHIR JSON消息的技术咨询

1. 直接构建JSON对象替代模板替换 #

模板替换容易触发格式错误（比如特殊字符未转义、字段缺失或结构混乱），更可靠的方式是用VBA的Scripting.Dictionary或自定义类构建FHIR Patient资源的结构化数据，再通过JSON序列化工具转换为标准JSON字符串。

示例代码（依赖VBA-JSON模块，直接导入VBA编辑器即可）：

Sub GenerateFHIRPatients()
    Dim patientDict As New Scripting.Dictionary
    Dim lastRow As Long, rowNum As Long
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 禁用Excel提升性能
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For rowNum = 2 To lastRow ' 假设表头在第1行，数据从第2行开始
        ' 初始化资源结构
        Set patientDict = New Scripting.Dictionary
        patientDict("resourceType") = "Patient"
        patientDict("id") = "patient-" & CStr(Cells(rowNum, 1).Value) ' 用第一列作为唯一ID
        
        ' 构建姓名字段
        Dim nameDict As New Scripting.Dictionary
        nameDict("family") = Cells(rowNum, 2).Value
        nameDict("given") = Array(Cells(rowNum, 3).Value)
        patientDict("name") = Array(nameDict)
        
        ' 构建出生日期（转成FHIR要求的yyyy-MM-dd格式）
        If IsDate(Cells(rowNum, 4).Value) Then
            patientDict("birthDate") = Format(Cells(rowNum, 4).Value, "yyyy-MM-dd")
        End If
        
        ' 构建地址字段
        Dim addressDict As New Scripting.Dictionary
        addressDict("line") = Array(Cells(rowNum, 5).Value)
        addressDict("city") = Cells(rowNum, 6).Value
        addressDict("postalCode") = Cells(rowNum, 7).Value
        patientDict("address") = Array(addressDict)
        
        ' 序列化为JSON并写入单元格
        Dim jsonConverter As New JsonConverter
        Cells(rowNum, 8).Value = jsonConverter.ConvertToJson(patientDict, Whitespace:=2)
    Next rowNum
    
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

2. 封装FHIR资源构建逻辑 #

把Patient资源的构建逻辑封装成独立函数，便于复用和维护。比如：

Function CreateFHIRPatient(patientId As String, familyName As String, _
                          givenName As String, birthDate As String, _
                          addressLine As String, city As String, postalCode As String) As Scripting.Dictionary
    Dim patientDict As New Scripting.Dictionary
    patientDict("resourceType") = "Patient"
    patientDict("id") = patientId
    
    ' 姓名
    Dim nameDict As New Scripting.Dictionary
    nameDict("family") = familyName
    nameDict("given") = Array(givenName)
    patientDict("name") = Array(nameDict)
    
    ' 出生日期
    If birthDate <> "" Then patientDict("birthDate") = birthDate
    
    ' 地址
    Dim addressDict As New Scripting.Dictionary
    addressDict("line") = Array(addressLine)
    addressDict("city") = city
    addressDict("postalCode") = postalCode
    patientDict("address") = Array(addressDict)
    
    Set CreateFHIRPatient = patientDict
End Function

这样在批量处理时，只需调用Set patientDict = CreateFHIRPatient(...)即可，后续FHIR规范更新时，仅需修改该函数。

3. 数据校验与异常处理 #

在生成JSON前，对Excel数据做校验，避免生成不符合FHIR规范的内容：

' 示例：校验必填字段
If Trim(Cells(rowNum, 2).Value) = "" Then
    Debug.Print "第" & rowNum & "行姓氏为空，跳过处理"
    Continue For
End If
If Not IsDate(Cells(rowNum, 4).Value) Then
    Debug.Print "第" & rowNum & "行出生日期格式无效"
    Continue For
End If

可以把校验逻辑也封装成函数，统一处理错误提示或日志记录。

4. 批量处理优化 #

• 禁用Excel的屏幕更新和事件触发，减少处理大文件时的卡顿。
• 若需导出到文件，建议批量生成所有JSON后一次性写入，而非逐行写入，降低IO开销。比如：

Dim jsonOutput As String
jsonOutput = "[" & vbCrLf ' 构建JSON数组
For rowNum = 2 To lastRow
    ' 生成单个patient的JSON
    Dim singleJson As String
    singleJson = jsonConverter.ConvertToJson(patientDict, Whitespace:=2)
    jsonOutput = jsonOutput & singleJson & "," & vbCrLf
Next rowNum
' 移除最后一个逗号并闭合数组
jsonOutput = Left(jsonOutput, Len(jsonOutput) - 2) & vbCrLf & "]"

' 写入文件
Open "C:\FHIR_Patients.json" For Output As #1
Print #1, jsonOutput
Close #1

5. 严格遵循FHIR规范映射字段 #

对照FHIR Patient资源的定义，确保每个字段的类型、结构完全符合规范：

• 比如name字段是数组类型，每个元素包含family和given（数组）；
• birthDate必须是yyyy-MM-dd格式的字符串；
• address的子字段如line、city需按规范命名，不能自定义字段名。

内容的提问来源于stack exchange，提问作者Sardum