Program to get product and base folder IDs

1. Preferences

Enter the address in the config sheet
Enter the address and port

2. Get Product Infomation 

---

□ Code

Option Explicit
Sub ProductName01()

        '// Output error message when an error occurs
        On Error Resume Next
        
        Call MainGetToken.GetToken001
     
       '// Variable
        Dim xmlhttp As Object
        Set xmlhttp = CreateObject("MSXML2.XMLHTTP.6.0")
        Dim Url As String
        Dim requestBody As String
        Dim GetresponseText As String
        Dim status As Integer
        Dim jsonObject As Object
        Dim jsonItem As Object
        Dim ProductType As String
        Dim j As Integer
        
        
         '// URL settings
        Url = Worksheets("Config").Cells(2, "B").Value + "/Windchill/servlet/odata/v6/DataAdmin/Containers?$count=false"
       
            
        '// Open a connection to the server
        xmlhttp.Open "GET", Url, False
        
        '//Setting request headers
        xmlhttp.SetRequestHeader "Content-Type", "application/json"
        xmlhttp.SetRequestHeader "CSRF_NONCE", NonceTorken("NonceValue")
        
        '//Send Request
        xmlhttp.Send requestBody
    
        '// Output error message to debug window when error occurs
        If Err.Number <> 0 Then
            Debug.Print "Error " & Err.Number & ": " & Err.Description
            On Error GoTo 0
            Exit Sub
        End If
    
        '// Get response status code
        status = xmlhttp.status
        
        '// Get response text
        GetresponseText = xmlhttp.responseText
        
        '// JSON Parsing
        Set jsonObject = JsonConverter.ParseJson(GetresponseText)
        
        '// Output data to "ProductID"
        j = 1
                For Each jsonItem In jsonObject("value")
                         If jsonItem("@odata.type") = "#PTC.DataAdmin.ProductContainer" Then
                                       
                                            Worksheets("ProductName").Cells(j + 6, "A") = j
                                            Worksheets("ProductName").Cells(j + 6, "B") = jsonItem("ID")
                                            Worksheets("ProductName").Cells(j + 6, "C") = jsonItem("Name")
                                            Worksheets("ProductName").Cells(j + 6, "E") = jsonItem("CreatedOn")
                                            
                                            j = j + 1
                                        
                            End If

                Next jsonItem
        
        
        '// Clean up work
        Set xmlhttp = Nothing

End Sub
Sub DefaulteFolderID01()

       '// Output error message when an error occurs
        On Error Resume Next
        
        Call ProductName01
        
        Dim rng As Range
        Set rng = Worksheets("ProductName").Range("A7", Cells(Rows.Count, "A").End(xlUp))
        
       '// Variable
        Dim xmlhttp As Object
        Set xmlhttp = CreateObject("MSXML2.XMLHTTP.6.0")
        Dim Url As String
        Dim requestBody As String
        Dim GetresponseText As String
        Dim status As Integer
        Dim jsonObject As Object
        Dim jsonItem As Object
        Dim ProductType As String
        Dim ProductID As String
        Dim i As Integer
        
        
        For i = 0 To rng.Count - 1
                    
                 ProductID = Worksheets("ProductName").Cells(i + 7, "B")
                 
                 '// URL settings
                 Url = Worksheets("Config").Cells(2, "B").Value + "/Windchill/servlet/odata/v6/DataAdmin/Containers('" & ProductID & "')/Folders"
        
        
                '// Open a connection to the server
                xmlhttp.Open "GET", Url, False
        
                '//Setting request headers
                xmlhttp.SetRequestHeader "Content-Type", "application/json"
                xmlhttp.SetRequestHeader "CSRF_NONCE", NonceTorken("NonceValue")
            
                '//Send Request
                xmlhttp.Send requestBody
            
                '// Output error message to debug window when error occurs
                If Err.Number <> 0 Then
                     Debug.Print "Error " & Err.Number & ": " & Err.Description
                     On Error GoTo 0
                    Exit Sub
                End If
                
             '// Get response status code
             status = xmlhttp.status
             
            '// Get response text
             GetresponseText = xmlhttp.responseText
             
             '// JSON Parsing
              Set jsonObject = JsonConverter.ParseJson(GetresponseText)
                   
              For Each jsonItem In jsonObject("value")
                              
              Worksheets("ProductName").Cells(i + 7, "D") = "Containers('" & ProductID & "')" & "/Folders('" & jsonItem("ID") & "')"
                        
               Next jsonItem
            
       Next i
            
        Set xmlhttp = Nothing
        
        MsgBox "Get product and default folder IDs "

End Sub

 

Program File

VBA_Windchill_ProductName.xlsm

0.08MB