專案管理(Project Management)

列出專案清單(Listing Projects)

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

這裡除了列出專案清單外，其實也一起列出了專案內的表單與資料集清單，只要是權限範圍內，就會全部秀出，其中也包含了表單與資料集清單。

Function ODK_Projects_ListingAll()
    Dim strUrl As String
    Dim strReqBody As String
    
    strMethod = "GET"
    strUrlOpt = "/v1/projects"
    
    strReqBody = ""
    
    strReqHeader1 = "Authorization"
    strReqHeader2 = "Bearer " & ConfigLocal("ODK_Token")
    
    strParameter1 = "forms"
    strParameter1v = False
    
    'forms (query)/ Boolean

    strParameter2 = "datasets"
    strParameter2v = False

    strUrl = ConfigCloud("F_ODK_Url") & strUrlOpt & "?" & strParameter1 & "=" & strParameter1v & "&" & strParameter2 & "=" & strParameter2v
        
    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 "Project List: OK!"
                ODK_Projects_ListingAll = True
                Call WriteToUTF8 (CStr(strResponse), strPath & "\" & "ODK_Projects_" & Format(Now, "YYYYMMDD_HHMMSS") & ".json")
                
            Else
                Debug.Print "Project List: Fail.."
                ODK_Projects_ListingAll = False
                Exit Function
            End If
        End With
    
        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
        
        
        JsonParser.InitScriptEngine
        Set root = JsonParser.DecodeJsonString(strResponse)

        'Projects
        For Each key In GetKeys(root)
            
            keyVal = GetProperty(root, key)
            
            Set obj1 = JsonParser.GetObjectProperty(root, key)
     
            str_id = JsonParser.GetProperty(obj1, "id")
            str_name = JsonParser.GetProperty(obj1, "name")
            str_description = JsonParser.GetProperty(obj1, "description")
            str_createdAt = UTC_0600(JsonParser.GetProperty(obj1, "createdAt"))
            str_updatedAt = UTC_0600(JsonParser.GetProperty(obj1, "updatedAt"))
            str_lastSubmission = UTC_0600(JsonParser.GetProperty(obj1, "lastSubmission"))
            
            'str_Verbs = JsonParser.GetProperty(obj1, "verbs")
            
            strSQL = "SELECT * FROM ODK_Projects WHERE id=" & str_id
            Set m = CurrentDb.OpenRecordset(strSQL)
            If m.EOF Then
                m.AddNew
                m("id") = str_id
            Else
                m.Edit
            End If
            
            m("name") = str_name
            m("description") = str_description
            m("createdAt") = str_createdAt
            If IsDate(str_updatedAt) Then m("updatedAt") = str_updatedAt
            If IsDate(str_lastSubmission) Then m("lastSubmission") = str_lastSubmission
            m.Update

            
            Set obj_formList = JsonParser.GetObjectProperty(obj1, "formList")
            
            If obj_formList = "" Then
            
            Else
                For Each Key2 In GetKeys(obj_formList)
                    
                    keyVal2 = GetProperty(obj_formList, Key2)
                    
                    Set obj2 = JsonParser.GetObjectProperty(obj_formList, Key2)
                    
                    
                    str_f_formId = Key2
                    
                    str_f_projectId = JsonParser.GetProperty(obj2, "projectId")
                    str_f_xmlFormId = JsonParser.GetProperty(obj2, "xmlFormId")
                    str_f_name = JsonParser.GetProperty(obj2, "name")
                    
                    str_f_createdAt = UTC_0600(JsonParser.GetProperty(obj2, "createdAt"))
                    str_f_publishedAt = UTC_0600(JsonParser.GetProperty(obj2, "publishedAt"))
                    str_f_updatedAt = UTC_0600(JsonParser.GetProperty(obj2, "updatedAt"))
                    str_f_submissions = JsonParser.GetProperty(obj2, "submissions")
                    str_f_state = JsonParser.GetProperty(obj2, "state")
                    
                    strSQL2 = "SELECT * FROM ODK_Forms WHERE formId=" & str_f_formId & " AND projectId=" & str_f_projectId & ""
                    Set m2 = CurrentDb.OpenRecordset(strSQL2)
                    If m2.EOF Then
                        m2.AddNew
                        m2("formId") = str_f_formId
                        m2("projectId") = str_f_projectId
                    Else
                        m2.Edit
                    End If
                    
                    m2("xmlFormId") = str_f_xmlFormId
                    m2("name") = str_f_name
                    m2("createdAt") = str_f_createdAt
                    If IsDate(str_f_publishedAt) Then m2("publishedAt") = str_f_publishedAt
                    If IsDate(str_f_updatedAt) Then m2("updatedAt") = str_f_updatedAt
                    m2("submissions") = str_f_submissions
                    m2("state") = str_f_state
                    m2.Update
                  
                    
                Next
            End If
            
            Set obj_datasetList = JsonParser.GetObjectProperty(obj1, "datasetList")
            
            If obj_datasetList = "" Then
            
            Else
                For Each Key3 In GetKeys(obj_datasetList)
                'For Each key2 In GetKeys(JsonParser.GetObjectProperty(obj1, "formList"))
                    
                    keyVal3 = GetProperty(obj_datasetList, Key3)
                    
                    Set obj3 = JsonParser.GetObjectProperty(obj_datasetList, Key3)
                    
                    str_d_projectId = JsonParser.GetProperty(obj3, "projectId")
                    str_d_name = JsonParser.GetProperty(obj3, "name")
                    str_d_entities = JsonParser.GetProperty(obj3, "entities")
                    str_d_createdAt = UTC_0600(JsonParser.GetProperty(obj3, "createdAt"))
                    str_d_approvalRequired = JsonParser.GetProperty(obj3, "approvalRequired")
                    str_d_conflicts = JsonParser.GetProperty(obj3, "conflicts")
                    str_d_lastEntity = UTC_0600(JsonParser.GetProperty(obj3, "lastEntity"))
                
                    strSQL3 = "SELECT * FROM ODK_Dataset WHERE projectId=" & str_d_projectId & " AND name='" & str_d_name & "'"
                    Set m3 = CurrentDb.OpenRecordset(strSQL3)
                    If m3.EOF Then
                        m3.AddNew
                        m3("projectId") = str_d_projectId
                        m3("name") = str_d_name
                    Else
                        m3.Edit
                    End If
                    
                    m3("entities") = str_d_entities
                    m3("createdAt") = str_d_createdAt
                    m3("approvalRequired") = str_d_approvalRequired
                    m3("conflicts") = str_d_conflicts
                    If str_d_lastEntity <> "" Then m3("lastEntity") = str_d_lastEntity
                    m3.Update
                
                Next
            
            End If
        Next

End Function

這邊有些其他的子程式:
GetSpecialFolderNames() 取得特殊資料夾路徑:

Function GetSpecialFolderNames(strFolderName) As String
'   strFolderName : One of the following special folders
'                   (not all are available to all flavors of Windows)

    'Desktop, StartMenu, Favorites, MyDocuments
    'Programs, Startup,  Fonts

    'AllUsersDesktop
    'AllUsersStartMenu
    'AllUsersPrograms
    'AllUsersStartup

    'NetHood
    'PrintHood
    'Recent
    'SendTo
    'Templates
'
    Dim objFolders As Object
    Set objFolders = CreateObject("WScript.Shell").SpecialFolders
    GetSpecialFolderNames = objFolders(strFolderName)
End Function

MakeDir() 可以建立資料夾，請參閱：

Access VBA 的眉眉角角Day11: 資料夾與檔案的處理
https://ithelp.ithome.com.tw/m/articles/10185612

WriteToUTF8()可以寫入UTF-8文字檔，可參閱：

Excel VBA 的眉眉角角Day15:關於寫入純文字檔的這檔事
https://ithelp.ithome.com.tw/articles/10158519

JSON資料處理：
Access VBA 之 iT管理實做Day30: JSON資料的收集-以youtube-dl為例
https://ithelp.ithome.com.tw/m/articles/10209806

另外資料寫入到：ODK_Projects、ODK_Forms與ODK_Dataset這三個資料檔。

ODK_Projects：用來存放專案清單

ODK_Forms：用來存放表格清單

ODK_Dataset：用來存放資料集清單