如何在VBA中提取指定src_id的JSON响应值（无法安装扩展）

由于无法安装JSON解析扩展，我们可以通过原生字符串处理逻辑来提取目标字段，以下是具体实现：

1. 完整修改后的函数代码 #

Function GetCmpd(inchi_key As String) As String
    Dim url As String
    url = "https://www.ebi.ac.uk/unichem/rest/inchikey/" & inchi_key
    On Error GoTo ErrorHandler

    Dim functionAccess As Object
    Set functionAccess = CreateUnoService("com.sun.star.sheet.FunctionAccess")

    ' 获取完整JSON响应
    Dim Cmpd_data As String
    Cmpd_data = functionAccess.callFunction("WEBSERVICE", Array(url))

    ' 定义要匹配的src_id
    Dim targetSrcId As String
    targetSrcId = "1"
    Dim result As String
    result = ""

    ' 定位目标src_id的位置
    Dim searchMarker As String
    searchMarker = """src_id"": """ & targetSrcId & """"
    Dim markerPos As Integer
    markerPos = InStr(Cmpd_data, searchMarker)

    If markerPos > 0 Then
        ' 向后查找对应的src_compound_id字段
        Dim compoundKeyPos As Integer
        compoundKeyPos = InStr(markerPos, Cmpd_data, """src_compound_id"": """)
        If compoundKeyPos > 0 Then
            ' 提取字段值的起始和结束位置
            Dim valStart As Integer
            valStart = compoundKeyPos + Len("""src_compound_id"": """)
            Dim valEnd As Integer
            valEnd = InStr(valStart, Cmpd_data, """")
            
            If valEnd > valStart Then
                result = Mid(Cmpd_data, valStart, valEnd - valStart)
            End If
        End If
    End If

    GetCmpd = IIf(result <> "", result, "未找到匹配的src_id")
    Exit Function

ErrorHandler:
    GetCmpd = "Error " & Err.Number & ": " & Err.Description
End Function

2. 代码逻辑说明 #

• 字符串定位：通过InStr函数找到目标src_id的位置，再向后定位对应的src_compound_id键名
• 值提取：截取键名后第一个双引号到下一个双引号之间的内容，即为目标字段值
• 兼容性：完全依赖原生字符串处理函数，无需任何外部扩展或库，适配受限工作环境
• 容错处理：未找到匹配项时返回提示信息，保留原有错误捕获逻辑

3. 使用说明 #

• 若要提取其他src_id对应的值，只需修改targetSrcId变量的内容（例如改为"7"即可返回"31843"）
• 测试示例JSON时，函数会直接返回CHEMBL544428

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