I’ve built a simple GET and PATCH for a header table using an update BAQ that works. Now, I’m trying to build a Parent/Child similar one – But I’m just stumped. Has anyone seen have any documentation you’re run across for a similar solution?
I’m trying to update the Project Tasks - I’ve tried a flat JSON and a Nested JSON. I keep getting a 400 error Unable to deserialize payload…
Here’s a version of the main function that gives me that error…
’ ============================================================
’ UPDATE: BACKUP + CHANGE DETECT + PATCH ONLY CHANGED ROWS
’ ============================================================
Sub UpdateProjectChecklist()
Dim wb As Workbook
Dim ws As Worksheet, wsOrig As Worksheet
Dim http As Object
Dim epicorUser As String, epicorPass As String, encodedAuth As String
Dim lastRow As Long, lastCol As Long
Dim r As Long, c As Long
Dim headers() As String
Dim changed As Boolean
Dim origRowIndex As Long
Dim jsonBody As String
On Error GoTo ErrHandler
InitDatePatterns
Set wb = ThisWorkbook
Set ws = wb.Worksheets(dataSheetName)
Set wsOrig = wb.Worksheets(origSheetName)
If wsOrig Is Nothing Then
MsgBox "Original data snapshot not found. Please run GetProjectChecklist first.", vbExclamation
Exit Sub
End If
' --- Login ---
frmEpicorLogin.Show
epicorUser = frmEpicorLogin.txtUser.Value
epicorPass = frmEpicorLogin.txtPass.Value
If epicorUser = "" Or epicorPass = "" Then
MsgBox "Operation cancelled."
Exit Sub
End If
encodedAuth = "Basic " & Base64Encode(epicorUser & ":" & epicorPass)
Set http = CreateObject("MSXML2.XMLHTTP.6.0")
' --- Sheet shape ---
lastCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
If lastRow < 6 Then
MsgBox "No rows to update.", vbInformation
Exit Sub
End If
ReDim headers(1 To lastCol - 1) ' last column is UpdateResult
For c = 1 To lastCol - 1
headers(c) = CStr(ws.Cells(5, c).Value)
Next c
' --- Locate key columns (by BAQ alias names) ---
Dim colProjCompany As Long, colProjID As Long, colProjSys As Long
Dim colTaskProjID As Long, colTaskID As Long, colTaskSys As Long
colProjCompany = GetHeaderCol(ws, "Project_Company")
colProjID = GetHeaderCol(ws, "Project_ProjectID")
colProjSys = GetHeaderCol(ws, "Project_SysRowID")
colTaskProjID = GetHeaderCol(ws, "ProjectTask_ProjectID")
colTaskID = GetHeaderCol(ws, "ProjectTask_TaskID")
colTaskSys = GetHeaderCol(ws, "ProjectTask_SysRowID")
If colProjCompany = 0 Or colProjID = 0 Or colProjSys = 0 _
Or colTaskProjID = 0 Or colTaskID = 0 Or colTaskSys = 0 Then
MsgBox "One or more key columns (Project_Company, Project_ProjectID, Project_SysRowID, ProjectTask_ProjectID, ProjectTask_TaskID, ProjectTask_SysRowID) not found in row 5.", vbCritical
Exit Sub
End If
' --- Loop rows ---
Dim parts As Collection
Dim i As Long
For r = 6 To lastRow
Application.StatusBar = "Updating row " & r & " of " & lastRow
origRowIndex = r ' mirror layout: same row index in wsOrig
changed = False
' --- Change detection on updatable fields only ---
For c = 1 To lastCol - 1
Dim hdr As String
Dim valNow As String, valOrig As String
hdr = headers(c)
If IsUpdatableField(hdr) Then
If IsDateField(hdr) Then
valNow = ExcelToIso(ws.Cells(r, c).Value)
valOrig = CStr(wsOrig.Cells(origRowIndex, c).Value)
Else
valNow = CStr(ws.Cells(r, c).Value)
valOrig = CStr(wsOrig.Cells(origRowIndex, c).Value)
End If
If valNow <> valOrig Then
changed = True
Exit For
End If
End If
Next c
If Not changed Then
ws.Cells(r, lastCol).Value = "No change"
GoTo NextRow
End If
' =====================================================
' BUILD FLAT JSON – using BAQ "Updatable Columns" names
' =====================================================
Set parts = New Collection
' --- Required header keys ---
parts.Add """Project_Company"":""" & CStr(ws.Cells(r, colProjCompany).Value) & """"
parts.Add """Project_ProjectID"":""" & CStr(ws.Cells(r, colProjID).Value) & """"
parts.Add """Project_SysRowID"":""" & CStr(ws.Cells(r, colProjSys).Value) & """"
' --- Required task keys ---
parts.Add """ProjectTask_ProjectID"":""" & CStr(ws.Cells(r, colTaskProjID).Value) & """"
parts.Add """ProjectTask_TaskID"":""" & CStr(ws.Cells(r, colTaskID).Value) & """"
parts.Add """ProjectTask_SysRowID"":""" & CStr(ws.Cells(r, colTaskSys).Value) & """"
' --- Updatable fields (by alias name) ---
For c = 1 To lastCol - 1
Dim cellVal As Variant
Dim hdr2 As String
hdr2 = headers(c)
cellVal = ws.Cells(r, c).Value
Select Case hdr2
Case "ProjectTask_Description"
parts.Add """ProjectTask_Description"":""" & Replace(CStr(cellVal), """", "'") & """"
Case "ProjectTask_StartDate"
If IsDate(cellVal) Then
parts.Add """ProjectTask_StartDate"":""" & ExcelToIso(cellVal) & """"
Else
parts.Add """ProjectTask_StartDate"":null"
End If
Case "ProjectTask_DueDate"
If IsDate(cellVal) Then
parts.Add """ProjectTask_DueDate"":""" & ExcelToIso(cellVal) & """"
Else
parts.Add """ProjectTask_DueDate"":null"
End If
Case "ProjectTask_TaskStatus"
parts.Add """ProjectTask_TaskStatus"":""" & CStr(cellVal) & """"
Case "ProjectTask_PersonID"
If Trim(CStr(cellVal) & "") = "" Then
parts.Add """ProjectTask_PersonID"":null"
Else
parts.Add """ProjectTask_PersonID"":""" & Replace(CStr(cellVal), """", "'") & """"
End If
Case "ProjectTask_Duration"
If Trim(CStr(cellVal) & "") = "" Then
parts.Add """ProjectTask_Duration"":null"
ElseIf IsNumeric(cellVal) Then
parts.Add """ProjectTask_Duration"":" & CStr(cellVal)
Else
parts.Add """ProjectTask_Duration"":null"
End If
End Select
Next c
' --- Required RowMod for update ---
parts.Add """RowMod"":""U"""
' --- Assemble JSON ---
jsonBody = "{"
For i = 1 To parts.Count
jsonBody = jsonBody & parts(i)
If i < parts.Count Then jsonBody = jsonBody & ","
Next i
jsonBody = jsonBody & "}"
Debug.Print jsonBody
' --- Send PATCH ---
http.Open "PATCH", epicorURL, False
http.setRequestHeader "Authorization", encodedAuth
http.setRequestHeader "x-api-key", apiKey
http.setRequestHeader "Content-Type", "application/json"
http.setRequestHeader "Accept", "application/json"
http.Send jsonBody
If http.Status = 200 Or http.Status = 204 Then
ws.Cells(r, lastCol).Value = "Updated OK"
' Mirror current row to original
wsOrig.Rows(origRowIndex).Value = ws.Rows(r).Value
Else
ws.Cells(r, lastCol).Value = "Error " & http.Status & ": " & Left(http.responseText, 300)
Debug.Print "ERROR RESPONSE: " & http.responseText
Stop
End If
NextRow:
Next r
Application.StatusBar = False
MsgBox "Project checklist update complete."
Exit Sub
ErrHandler:
Application.StatusBar = False
MsgBox "Error in UpdateProjectChecklist: " & Err.Description, vbCritical
End Sub
