提交資料管理 Submission Management

提交資料清單(Submissions_ListingAll)

相關說明文件網址：
https://docs.getodk.org/central-api-submission-management/

以下程式可以將提交資料清單下載並轉入Access，這邊只有清單，並沒有詳細內容，例如重複項目中的每筆資料。

Function ODK_Submissions_ListingAll(int_projectId, int_formID, strXmlFormId, strLastDate)

    Dim key As Variant
    Dim Key2 As Variant
    Dim keyVal As Variant
    Dim keyVal2 As Variant
    Dim n As Integer
    Dim obj_formList As Variant
        
    If IsNull(strLastDate) Then
        strLastDate2 = "2024-01-01T00:00:00.000Z"
    Else
        strLastDate2 = Format(strLastDate, "00-00-00") & "T00:00:00.000Z"
    End If
    
    Debug.Print Format(strLastDate, "00-00-00")
    
    Dim strUrl As String
    Dim strReqBody As String
    
    strMethod = "GET"
    strQuery = "?%24filter=__system/submissionDate gt " & strLastDate2 & " "
    strUrlOpt = "/v1/projects/" & int_projectId & "/forms/" & strXmlFormId & "/submissions" & strQuery
    
    strReqBody = ""
    
    strReqHeader1 = "Authorization"
    strReqHeader2 = "Bearer " & ConfigLocal("ODK_Token")
    
    
    strUrl = ConfigCloud("F_ODK_Url") & strUrlOpt
        
    Set hReq = CreateObject("MSXML2.XMLHTTP")
        
        strPath = GetSpecialFolderNames("MyDocuments") & "\ODK\JSON"
        Call MakeDir(CStr(strPath))
        
        With hReq
            .Open strMethod, strUrl, False
            .setRequestHeader strReqHeader1, strReqHeader2
            .send strReqBody
            While hReq.ReadyState <> 4
                DoEvents
            Wend
            strResponse = hReq.responseText
            Debug.Print strResponse
            If Len(strResponse) > 10 And InStr(strResponse, "Could not authenticate") = 0 Then
                Debug.Print "Submissions_ListingAll : OK!"
                ODK_Submissions_ListingAll = True
                WriteToUTF8 CStr(strResponse), strPath & "\" & "ODK_Submissions_" & Format(Now, "YYYYMMDD_HHMMSS") & ".json"
            Else
                ODK_Submissions_ListingAll = False
                Debug.Print ":Submissions_ListingAll: Fail.."
                Exit Function
            End If
        End With
    

        
        
        JsonParser.InitScriptEngine
        Set root = JsonParser.DecodeJsonString(strResponse)

        If hReq.STATUS = 200 Then
        'Projects
            For Each key In GetKeys(root)
                
                keyVal = GetProperty(root, key)
                
                Set obj1 = JsonParser.GetObjectProperty(root, key)
         
                str_instanceId = JsonParser.GetProperty(obj1, "instanceId")
                str_submitterId = JsonParser.GetProperty(obj1, "submitterId")
                str_deviceId = JsonParser.GetProperty(obj1, "deviceId")
                str_createdAt = UTC_0600(JsonParser.GetProperty(obj1, "createdAt"))
                str_updatedAt = UTC_0600(JsonParser.GetProperty(obj1, "updatedAt"))
                str_reviewState = JsonParser.GetProperty(obj1, "reviewState")
                str_userAgent = JsonParser.GetProperty(obj1, "userAgent")
                
                'str_Verbs = JsonParser.GetProperty(obj1, "verbs")
                
                'str_instanceId = Replace(str_instanceId, "uuid:", "")
                
                strSQL = "SELECT * FROM ODK_Submissions WHERE xmlFormId='" & strXmlFormId & "' AND formId=" & int_formID & "  AND projectId=" & int_projectId & " AND instanceId='" & str_instanceId & "'"
                Set m = CurrentDb.OpenRecordset(strSQL)
                If m.EOF Then
                    m.AddNew
                    m("xmlFormId") = strXmlFormId
                    m("projectId") = int_projectId
                    m("formId") = int_formID
                    m("instanceId") = str_instanceId
                Else
                    m.Edit
                End If
                
                m("submitterId") = str_submitterId
                m("deviceId") = str_deviceId
                m("createdAt") = str_createdAt
                If IsDate(str_updatedAt) Then m("updatedAt") = str_updatedAt
                m("reviewState") = str_reviewState
                m("userAgent") = str_userAgent
                m.Update
    
            Next
            ODK_Submissions_ListingAll = True
        Else
            ODK_Submissions_ListingAll = False
        End If
        
End Function

ODK_Submissions：用來存放提交資料清單