通过Access VBE从JSON批量插入数据失败：仅单条记录插入

开发者阿泽

2026-6-27

Access VBE插入JSON交易记录仅成功一条的问题排查与修复

我尝试通过Access VBE将多条JSON格式的交易记录插入Access表，但执行后仅成功插入一条记录。以下是样本数据和使用的VBA代码：

样本JSON数据

{"GenericCorporateAlertRequest":[{"Alert Sequence No":"575000001248141603241","Account number":"57500000124814","Amount":"4900","Mnemonic Code":"OTH","Remitter IFSC":"PUNB0020720","User Reference Number":"PUNBZ24076278426","Cheque No":"","Transaction Description":"NEFT Cr-PUNB0020720-SURAVI DAS-Zuari Finserv Ltd-PUNBZ24076278426","Remitter Name":"SURAVI DAS","Remitter Account":"0207010327572","Value Date":"2024-03-16","Virtual Account":"","Remitter Bank":"PUNJAB NATIONAL BANK","Transaction Date":"2024-03-16 09:01","Debit Credit":"Credit"}]}

{"GenericCorporateAlertRequest":[{"Alert Sequence No":"575000001248141603242","Account number":"57500000124814","Amount":"100","Mnemonic Code":"OTH","Remitter IFSC":"PUNB0020720","User Reference Number":"PUNBZ24076280247","Cheque No":"","Transaction Description":"NEFT Cr-PUNB0020720-SURAVI DAS-Zuari Finserv Ltd-PUNBZ24076280247","Remitter Name":"SURAVI DAS","Remitter Account":"0207010327572","Value Date":"2024-03-16","Virtual Account":"","Remitter Bank":"PUNJAB NATIONAL BANK","Transaction Date":"2024-03-16 09:01","Debit Credit":"Credit"}]}

{"GenericCorporateAlertRequest":[{"Alert Sequence No":"575000001248141603243","Account number":"57500000124814","Amount":"12050","Mnemonic Code":"IMPS","Remitter IFSC":"9002","User Reference Number":"407609524712","Cheque No":"","Transaction Description":"IMPS CR ECMS-9002-ZUFL14PJAK01-Mr  ANIL  KUMAR-00000037009771200","Remitter Name":"Mr  ANIL  KUMAR","Remitter Account":"00000037009771200","Value Date":"2024-03-16","Virtual Account":"ZUFL14PJAK01","Remitter Bank":"","Transaction Date":"2024-03-16 09:23","Debit Credit":"Credit"}]}

{"GenericCorporateAlertRequest":[{"Alert Sequence No":"575000001248141603244","Account number":"57500000124814","Amount":"30000","Mnemonic Code":"OTH","Remitter IFSC":"BARB0VJKIDW","User Reference Number":"BARBQ24076449811","Cheque No":"","Transaction Description":"NEFT Cr-BARB0VJKIDW-SWETA JINDAL W O MANISH JINDAL-ZUARI FINSERV LTD-BARBQ24076449811","Remitter Name":"SWETA JINDAL W O MANISH JINDAL","Remitter Account":"77540100001894","Value Date":"2024-03-16","Virtual Account":"","Remitter Bank":"BANK OF BARODA","Transaction Date":"2024-03-16 11:42","Debit Credit":"Credit"}]}

原VBA代码

Function fun_Check_HDFC_API_Records()
Dim FolderName As String
Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FSOFile As Object
'Dim FileTime As String
DoCmd.SetWarnings 0
Dim Sql1, SQL2 As String
Dim T1, T2 As String
Dim P As Integer
P = 0
  Dim VerData1, VerData2 As Variant
   VerData1 = Array("Alert Sequence No", "Account number", "Amount", "Mnemonic Code", "Remitter IFSC", "User Reference Number", "Cheque No", "Transaction Description", "Remitter Name", "Remitter Account", "Value Date", "Virtual Account", "Remitter Bank", "Transaction Date", "Debit Credit")
   VerData2 = Array("AlertSequenceNo", "Accountnumber", "Amount", "MnemonicCode", "RemitterIFSC", "UserReferenceNumber", "ChequeNo", "TransactionDescription", "RemitterName", "RemitterAccount", "ValueDate", "VirtualAccount", "RemitterBank", "TransactionDate", "DebitCredit")
   
DoCmd.RunSQL "delete * from GenericCorporateAlertRequest"
FileTime = 0
RecordNo = 0
'Set the file name to a variable
FolderName = "D:\auto file\HDFC Bank Live\" & Format(Date, "ddMMYYYY") & "\"

'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(FolderName)

'Use For Each loop to loop through each file in the folder
'For Each FSOFile In FSOFolder.Files
Dim strFile As String, strLine As String
'MsgBox FSOFile
'Debug.Print FSOFile.Name
'strFile = FolderName & "\" & FSOFile.Name
'hdfc_trxn_20032024.txt
'strFile = FolderName & "hdfc_trxn_20032024.txt"
strFile = FolderName & "HDFC_21032024.txt"
'strFile = FolderName & "hdfc_trxn_21032024.txt"
'New Text Document.txt

'Text_SP_LogFileName.Value = Mid(FSOFile, Len(FSOFile) - 9, 6)
Dim Name1 As String

'Add data into Table Start 101

'Dim strFile As String, strLine As String
Dim SequenceNo As Integer
SequenceNo = 1
'strFile = FSOFile.Name
   
  
   Open strFile For Input As #1
   Do Until EOF(1)
      Line Input #1, strLine
    
         
  For P = 0 To 13
   '1
   T1 = VerData1(P)
   T2 = VerData1(P + 1)
   VerData2(P) = Mid(strLine, InStr(strLine, T1) + Len(T1) + 3, InStr(strLine, T2) - InStr(strLine, T1) - (Len(T1)) - 6)
   If Len(VerData2(P)) = 0 Then
   VerData2(P) = VerData2(P) & "-"
   End If
      'VerData2(P) = Mid(strLine, InStr(strLine, VerData1(P)) + Len(VerData1(P)) + 3, InStr(strLine, VerData1(P + 1)) - InStr(strLine, VerData1(P)) - (Len(VerData1(P))) - 6)
   Name1 = Sequencno & VerData1(P) & " - " & VerData2(P)
   Debug.Print Name1
  
     
   T1 = VerData1(14)
   VerData2(14) = Mid(strLine, InStr(strLine, T1) + Len(T1) + 3, InStr(strLine, "}]}") - InStr(strLine, T1) - (Len(T1)) - 4)
  Name1 = Sequencno & VerData1(14) & " - " & VerData2(14)
   Debug.Print Name1
     
   Next P


Debug.Print SequenceNo
            
      Sql1 = "insert into GenericCorporateAlertRequest (SequenceNo, [Alert Sequence No], [Account number], [Amount], [Mnemonic Code], [Remitter IFSC], [User Reference Number], [Cheque No], [Transaction Description], [Remitter Name], [Remitter Account], [Value Date], [Virtual Account], [Remitter Bank], [Transaction Date], [Debit Credit]) values "
      SQL2 = "('" & SequenceNo & "', '" & VerData2(0) & "', '" & VerData2(1) & "', '" & VerData2(2) & "', '" & VerData2(3) & "', '" & VerData2(4) & "', '" & VerData2(5) & "', '" & VerData2(6) & "', '" & VerData2(7) & "', '" & VerData2(8) & "', '" & VerData2(9) & "', '" & VerData2(10) & "', '" & VerData2(11) & "', '" & VerData2(12) & "', '" & VerData2(13) & "', '" & VerData2(14) & "');"
      DoCmd.RunSQL Sql1 & SQL2
      Debug.Print Sql1 & SQL2
     
             'waitsecond (1)
   '   End If
         SequenceNo = SequenceNo + 1
       

         Debug.Print strLine
  
         Loop
       
      
   Close #1


'Next

'Release the memory
Set FSOLibrary = Nothing
Set FSOFolder = Nothing
strFile = ""



'DoCmd.TransferText acExportDelim, , Ex_Table_Name, "w:\sk\" & Ex_Table_Name & ".txt", 1

'Text_ODIN_Responce.Value = "File Generated..."

End Function

问题原因分析

字符串截取逻辑脆弱：依赖字段顺序绝对固定，一旦JSON字段顺序变化或存在格式差异（如空格、换行），就会提取失败。且循环中重复给VerData2(14)赋值，覆盖之前结果。
未处理空行：样本数据中每条JSON间有空行，Line Input #1读取空行后，字符串截取得到空值，触发SQL错误，但因关闭了警告，错误被隐藏，后续记录无法插入。
变量拼写错误：代码中Name1 = Sequencno & ...的Sequencno是拼写错误，应为SequenceNo，运行时错误被忽略后，后续循环无法正常执行。

修复方案

使用专业JSON解析库替代字符串截取，以下是修复后的代码：

Function fun_Check_HDFC_API_Records()
    Dim FolderName As String
    Dim strFile As String, strLine As String
    Dim JsonObj As Object
    Dim Transaction As Object
    Dim SequenceNo As Integer
    
    DoCmd.SetWarnings 0
    ' 清空目标表
    DoCmd.RunSQL "delete * from GenericCorporateAlertRequest"
    
    ' 设置文件夹路径
    FolderName = "D:\auto file\HDFC Bank Live\" & Format(Date, "ddMMYYYY") & "\"
    strFile = FolderName & "HDFC_21032024.txt"
    
    SequenceNo = 1
    Open strFile For Input As #1
    Do Until EOF(1)
        Line Input #1, strLine
        ' 跳过空行
        If Trim(strLine) = "" Then GoTo SkipLine
        
        ' 解析JSON（需先导入VBA-JSON库）
        On Error Resume Next
        Set JsonObj = JsonConverter.ParseJson(strLine)
        On Error GoTo 0
        
        If Not JsonObj Is Nothing Then
            ' 遍历交易记录
            For Each Transaction In JsonObj("GenericCorporateAlertRequest")
                ' 构造插入SQL，处理单引号避免语法错误
                Dim SqlStr As String
                SqlStr = "insert into GenericCorporateAlertRequest (" & _
                    "SequenceNo, [Alert Sequence No], [Account number], [Amount], " & _
                    "[Mnemonic Code], [Remitter IFSC], [User Reference Number], " & _
                    "[Cheque No], [Transaction Description], [Remitter Name], " & _
                    "[Remitter Account], [Value Date], [Virtual Account], " & _
                    "[Remitter Bank], [Transaction Date], [Debit Credit]) " & _
                    "values (" & _
                    SequenceNo & ", " & _
                    "'" & Replace(Transaction("Alert Sequence No"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Account number"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Amount"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Mnemonic Code"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Remitter IFSC"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("User Reference Number"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Cheque No"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Transaction Description"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Remitter Name"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Remitter Account"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Value Date"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Virtual Account"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Remitter Bank"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Transaction Date"), "'", "''") & "', " & _
                    "'" & Replace(Transaction("Debit Credit"), "'", "''") & "');"
                
                DoCmd.RunSQL SqlStr
                SequenceNo = SequenceNo + 1
            Next Transaction
        End If
        
SkipLine:
    Loop
    Close #1
    
    ' 释放对象
    Set JsonObj = Nothing
    DoCmd.SetWarnings 1
End Function

使用说明

导入VBA-JSON库：需先下载VBA-JSON库并导入到Access VBA项目中，实现可靠的JSON解析。
处理单引号：通过Replace函数替换字段中的单引号，避免SQL语法错误。
调试时开启警告：临时开启DoCmd.SetWarnings 1可排查潜在错误，调试完成后再关闭。

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

通过Access VBE从JSON批量插入数据失败：仅单条记录插入

样本JSON数据 #

原VBA代码 #

问题原因分析 #

修复方案 #

使用说明 #

样本JSON数据

原VBA代码

问题原因分析

修复方案

使用说明