VBA中使用MsgBox显示JSON内容触发424错误求助

一、核心错误原因及修复方案 #

1. JsonConverter对象未正确引入 #

424错误最可能的原因是JsonConverter未被识别，你需要将VBA-JSON的标准模块添加到你的Excel VBA工程中，确保JsonConverter.ConvertToJson方法能被正常调用。

2. Dictionary对象重复复用 #

你在循环外声明了Dim jsonDictionary As New Dictionary，每次循环仅往同一个字典里追加内容，未清空就重复添加到jsonItems集合，会导致数据混乱并触发对象类错误。
修复：每次处理新行时，重新创建一个Dictionary对象，避免复用旧对象。

3. Body变量未定义 #

XMLHTTP.Send Body中的Body未定义，且未关联转换后的JSON字符串，这会直接触发“需要对象”的424错误。
修复：将JsonConverter生成的JSON字符串赋值给变量，再传入Send方法。

4. IsEmpty判断字符串变量无效 #

cellValue是String类型，IsEmpty(cellValue)永远返回False，无法正确判断空值。
修复：改用cellValue = ""进行空值判断。

二、修复后的完整代码 #

Sub LoopThroughRowsByList()
   Dim iListRow As ListRow
   Dim iCol As Range
   Dim cellValue As String
   Dim arr3
   Dim count As Integer
   Dim XMLHTTP
   Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
 
   Dim jsonItems As New Collection
   Dim jsonDictionary As Dictionary ' 仅声明，不提前实例化
   Dim myurl As String
   Dim jsonStr As String ' 存储转换后的JSON字符串
    
    arr3 = Array("RequestType", "ItemCode", "Creator", "ResourceID", _
       "AccountCode", "Description", "OpportunityID", "TextFreeField1", _
       "TextFreeField8", "TextFreeField13", "TextFreeField14", _
       "DateFreeField2", "AmountFreeField4", "AmountFreeField5", _
        "NumberFreeField1")

    
    For Each iListRow In ActiveSheet.ListObjects("tabla").ListRows
        count = 0
        Set jsonDictionary = New Dictionary ' 每次循环新建字典
        For Each iCol In iListRow.Range
            If iCol.Value <> "" Then
                cellValue = iCol.Value
                jsonDictionary(arr3(count)) = cellValue
                count = count + 1 ' 空值时不递增索引，避免数组越界
            Else
                Exit For
            End If
         Next iCol
         
         ' 仅当字典有内容时添加到集合
         If jsonDictionary.Count > 0 Then
             jsonItems.Add jsonDictionary
         End If
         
         ' 判断空行，终止循环
         If cellValue = "" Then
            Exit For
         End If

         myurl = "myURL" ' 替换为你的实际接口地址
         XMLHTTP.Open "POST", myurl, False
         XMLHTTP.setRequestHeader "Content-Type", "application/json"
  
         ' 转换JSON并弹窗校验
         jsonStr = JsonConverter.ConvertToJson(jsonItems, whitespace:=3)
         MsgBox jsonStr
    
         ' 发送JSON数据
         XMLHTTP.Send jsonStr
         MsgBox XMLHTTP.responseText
         
         ' 清空集合，避免下一行数据累积
         Set jsonItems = New Collection
    Next iListRow
    
    ' 释放对象，避免内存泄漏
    Set XMLHTTP = Nothing
    Set jsonDictionary = Nothing
    Set jsonItems = Nothing
End Sub

三、额外注意事项 #

• 确认当前活动工作表中存在名为tabla的ListObject，拼写完全一致。
• 替换代码中的myURL为你的实际接口地址。
• 确保Excel已启用宏功能，且VBA工程中成功添加了VBA-JSON模块。

内容的提问来源于stack exchange，提问作者Juan Manuel Vela Pérez