J.P*_*ice 2 ms-access vba json
我正在尝试将 JSON 文件导入到 MS Access 表中。我在网上查了一下,发现这个堆栈溢出链接说明了这一点。自动解析 JSON feed 到 MS Access 我已复制并粘贴此字符串中的代码,并修改它以提取我的 JSON 文件,并且该代码似乎确实解析了该文件。但是,我在将解析文件的所有元素放入 Access 表时遇到问题。它似乎只引入不属于对象或数组的元素。换句话说,NPI 元素没有包含在方括号或大括号中,因此导入成功。请参阅下面的代码和 JSON 数据结构。
Private Function JSONImport()
Dim db As Database, qdef As QueryDef
Dim FileNum As Integer
Dim DataLine As String, jsonStr As String, strSQL As String
Dim P As Object, element As Variant
Set db = CurrentDb
' READ FROM EXTERNAL FILE
FileNum = FreeFile()
'Open "P:\PROF REIMB\PROF REIMB\HIX\CY 2021 Analysis\Centene\JSON\provider_facility - jun 52020.json"
For Input As #FileNum
' PARSE FILE STRING
jsonStr = ""
While Not EOF(FileNum)
Line Input #FileNum, DataLine
jsonStr = jsonStr & DataLine & vbNewLine
Wend
Close #FileNum
Set P = ParseJson(jsonStr)
' ITERATE THROUGH DATA ROWS, APPENDING TO TABLE
For Each element In P
strSQL = "PARAMETERS (first), [middle] Text(255), [last] Text(255), [suffix] Text(255), [npi]
Text(255), [type] Text(255), [addresses] Text(255), [addresses_2] Text(255), [city] Text(255),
[state] Text(255), [zip] Text(255), [phone] Text(255), [specialty] Text(255), [accepting]
Text(255), [plans] Text(255), [plan_id_type] Text(255), [plan_id] Text(255), [network_tier]
Text(255), [years] Text(255); " _
& "INSERT INTO FrmJSONFile (first, middle, last, suffix, npi, type, addresses,
addresses_2, city, state, zip, phone, specialty, accepting, plans, plan_id_type,
plan_id, network_tier, years) " _
& "VALUES([first], [middle], [last], [suffix], [npi], [type], [addresses], [addresses_2], [city],
[state], [zip], [phone], [specialty], [accepting], [plans], [plan_id_type], [plan_id],
[network_tier], [years]);"
Set qdef = db.CreateQueryDef("", strSQL)
qdef!first = element("first")
qdef!middle = element("middle")
qdef!last = element("last")
qdef!suffix = element("suffix")
qdef!npi = element("npi")
qdef!Type = element("type")
qdef!addresses = element("addresses")
qdef!addresses_2 = element("addresses_2")
qdef!city = element("city")
qdef!State = element("state")
qdef!Zip = element("zip")
qdef!phone = element("phone")
qdef!specialty = element("specialty")
qdef!accepting = element("accepting")
qdef!plans = element("plans")
qdef!plan_id_type = element("plan_id_type")
qdef!plan_id = element("plan_id")
qdef!network_tier = element("network_tier")
qdef!years = element("years")
qdef.Execute
Next element
Set element = Nothing
Set P = Nothing
Run Code Online (Sandbox Code Playgroud)
结束功能
JSON 文件:
[{
"name":{
"first":"John","middle":"G","last":"Doe","suffix":"MD"
},
"npi":"1234567891",
"type":"INDIVIDUAL",
"addresses":[
{"address":"123 Main St",
"address_2":"",
"city":"CHARLESTON",
"state":"SC",
"zip":"29406",
"phone":"8037779311"}
],
"specialty":["ANESTHESIOLOGY"],
"accepting":"not accepting",
"plans":[
{"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678912",
"network_tier":"PREFERRED","years":[2020]},
{"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678913",
"network_tier":"PREFERRED","years":[2020]},
{"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678914",
"network_tier":"PREFERRED","years":[2020]},
{"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678915",
"network_tier":"PREFERRED","years":[2020]},
{"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678916",
"network_tier":"PREFERRED","years":[2020]},
{"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678917",
"network_tier":"PREFERRED","years":[2020]},
{"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678918",
"network_tier":"PREFERRED","years":[2020]},
{"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678919",
"network_tier":"PREFERRED","years":[2020]}
],
"languages":["ENGLISH"],
"gender":"Male",
"last_updated_on":"2020-05-26"
}]
Run Code Online (Sandbox Code Playgroud)
因为您的 JSON 是一个嵌套集合(与更简单的平面链接问题不同),所以您需要在更深层次上提取参数值。VBA-JSON 模块将 every 映射[...]为集合,将 every{...}映射为字典。相关地,考虑导入到individual和plan的两个表中,可能用作相关的唯一标识符。这就是关系数据库的本质模型!不要只是像电子表格一样导入数据!最后,使用保存的查询并避免 VBA 中混乱的字符串连接。npi
SQL
个人追加查询(另存为存储查询以在 VBA 中调用)
PARAMETERS [prm_first] Text ( 255 ), [prm_middle] Text ( 255 ), [prm_last] Text ( 255 ),
[prm_suffix] Text ( 255 ), [prm_npi] Text ( 255 ), [prm_type] Text ( 255 ),
[prm_addresses] Text ( 255 ), [prm_addresses_2] Text ( 255 ), [prm_city] Text ( 255 ),
[prm_state] Text ( 255 ), [prm_zip] Text ( 255 ), [prm_phone] Text ( 255 ),
[prm_specialty] Text ( 255 ), [prm_accepting] Text ( 255 );
INSERT INTO individuals ( [first], middle, [last], suffix, npi, type, addresses,
addresses_2, city, state, zip, phone, specialty, accepting )
VALUES ([prm_first], [prm_middle], [prm_last], [prm_suffix], [prm_npi], [prm_type],
[prm_addresses], [prm_addresses_2], [prm_city], [prm_state], [prm_zip],
[prm_phone], [prm_specialty], [prm_accepting]);
Run Code Online (Sandbox Code Playgroud)
计划追加查询(另存为存储查询以在 VBA 中调用)
PARAMETERS [prm_npi] Text ( 255 ), [prm_plan_id_type] Text ( 255 ), [prm_plan_id] Text ( 255 ),
[prm_network_tier] Text ( 255 ), [prm_years] Long;
INSERT INTO plans ( npi, plan_id_type, plan_id, network_tier, years )
VALUES ([prm_npi], [prm_plan_id_type], [prm_plan_id], [prm_network_tier], [prm_years]);
Run Code Online (Sandbox Code Playgroud)
编程语言
Private Function JSONImport()
Dim db As Database, qdef As QueryDef
Dim FileNum As Integer
Dim DataLine As String, jsonStr As String, strSQL As String
Dim P As Object, element As Variant, sub_el As Variant
Set db = CurrentDb
' READ FROM EXTERNAL FILE
FileNum = FreeFile()
Open "C:\Path\To\myJSON.json" For Input As #FileNum
' PARSE FILE STRING
jsonStr = ""
While Not EOF(FileNum)
Line Input #FileNum, DataLine
jsonStr = jsonStr & DataLine & vbNewLine
Wend
Close #FileNum
Set P = ParseJson(jsonStr)
' ITERATE THROUGH DATA ROWS, APPENDING TO TABLE
For Each element In P
' INDIVIDUALS QUERY
Set qdef = db.QueryDefs("qryIndividualsAppend")
qdef!prm_first = element("name")("first")
qdef!prm_middle = element("name")("middle")
qdef!prm_last = element("name")("last")
qdef!prm_suffix = element("name")("suffix")
qdef!prm_npi = element("npi")
qdef!prm_type = element("type")
qdef!prm_addresses = element("addresses")(1)("address")
qdef!prm_addresses_2 = element("addresses")(1)("addresses_2")
qdef!prm_city = element("addresses")(1)("city")
qdef!prm_state = element("addresses")(1)("state")
qdef!prm_Zip = element("addresses")(1)("zip")
qdef!prm_phone = element("addresses")(1)("phone")
qdef!prm_specialty = element("specialty")(1)
qdef!prm_accepting = element("accepting")
qdef.Execute
Set qdef = Nothing
' PLANS QUERY
Set qdef = db.QueryDefs("qryPlansAppend")
' NESTED ITERATION THROUGH EACH PLANS ITEMS
For Each sub_el In element("plans")
qdef!prm_npi = element("npi")
qdef!prm_plan_id_type = sub_el("plan_id_type")
qdef!prm_plan_id = sub_el("plan_id")
qdef!prm_network_tier = sub_el("network_tier")
qdef!prm_years = sub_el("years")(1)
qdef.Execute
Next sub_el
Next element
Set element = Nothing: Set P = Nothing
Set qdef = Nothing: Set db = Nothing
End Function
Run Code Online (Sandbox Code Playgroud)