반응형
Please enter the product name
Enter the folder name for level 1
* Only level 1 folder names can be entered / This is a test of Excel VBA functions.
Please develop the program by referring to the code below.
Click the "Get Part Infomation" button to get WTPart information.
Clicking the "Clear Cell" button will delete the contents.
*caution
Please enter the windchill address in the config sheet. Please enter the address where you add the PORT number.
The number of WTParts loaded is limited to 1,000 / Quantity can be adjusted by modifying the code.
Description of program composition
1. Sub ProductName01() - Get the ID of the entered product
2. Sub DefaulteFolderID01() - Get the ID of the product base folder
3. Sub FolderName02() - Get the folder ID of the input level 1
4. Sub FileParameter01() - Get information from wtpart. Some items are parameters defined by the administrator.
Description of the main code of Sub FileParameter01()
'// url settings
Url = Worksheets("Config").Cells(2, "B").Value + "/Windchill/servlet/odata/v4/DataAdmin/Containers('" & ProductID & "')/Folders('" & DefaultFolderID & "')/Folders('" & SUBFolderID & "')/FolderContents/PTC.ProdMgmt.Part?%24top=1000"
'//Setting request headers
xmlhttp.SetRequestHeader "Content-Type", "application/json"
xmlhttp.SetRequestHeader "CSRF_NONCE", NonceTorken("NonceValue")
xmlhttp.SetRequestHeader "Prefer", "odata.maxpagesize=1000"PTC.ProdMgmt.Part?%24top=1000
xmlhttp.SetRequestHeader "Prefer", "odata.maxpagesize=1000"
1000 is the number of WTParts that can be imported. Up to 2000 is possible.
For Each jsonItem In jsonObject("value")
Worksheets("WTPartInfo").Cells(j + 8, "A") = j
Worksheets("WTPartInfo").Cells(j + 8, "B") = jsonItem("ID")
Worksheets("WTPartInfo").Cells(j + 8, "C") = jsonItem("Name")
Worksheets("WTPartInfo").Cells(j + 8, "D") = jsonItem("Number")
Worksheets("WTPartInfo").Cells(j + 8, "E") = jsonItem("PARTNO")
Worksheets("WTPartInfo").Cells(j + 8, "F") = jsonItem("PARTNAME")
Worksheets("WTPartInfo").Cells(j + 8, "G") = jsonItem("MATERIAL")
j = j + 1
Next jsonItemThis is the WTPart information that can be imported. Additions and modifications are possible.
Code
Option Explicit
Public ProductID As String
Public DefaultFolderID As String
Public SUBFolderID As String
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
'// 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"
For Each jsonItem In jsonObject("value")
If jsonItem("@odata.type") = "#PTC.DataAdmin.ProductContainer" Then
If Worksheets("WTPartInfo").Cells(6, "D") = jsonItem("Name") Then
ProductID = jsonItem("ID")
End If
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
'// 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
'// 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")
DefaultFolderID = jsonItem("ID")
Next jsonItem
Set xmlhttp = Nothing
End Sub
Sub FolderName02()
'// Output error message when an error occurs
On Error Resume Next
Call DefaulteFolderID01
'// 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('" & ProductID & "')/Folders('" & DefaultFolderID & "')/Folders?%24count=true"
'// 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")
If Worksheets("WTPartInfo").Cells(7, "D") = jsonItem("Name") Then
SUBFolderID = jsonItem("ID")
End If
Next jsonItem
Set xmlhttp = Nothing
End Sub
Sub FileParameter01()
'// 오류 발생 시 오류 메시지 출력
On Error Resume Next
Call FolderName02
'// 변수
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 설정
Url = Worksheets("Config").Cells(2, "B").Value + "/Windchill/servlet/odata/v4/DataAdmin/Containers('" & ProductID & "')/Folders('" & DefaultFolderID & "')/Folders('" & SUBFolderID & "')/FolderContents/PTC.ProdMgmt.Part?%24top=1000"
'// 서버와의 연결 열기
xmlhttp.Open "GET", Url, False
'//요청 헤더 설정
xmlhttp.SetRequestHeader "Content-Type", "application/json"
xmlhttp.SetRequestHeader "CSRF_NONCE", NonceTorken("NonceValue")
xmlhttp.SetRequestHeader "Prefer", "odata.maxpagesize=1000"
'//요청 보내기
xmlhttp.Send requestBody
'// 오류 발생 시 디버그 창에 오류 메시지 출력
If Err.Number <> 0 Then
Debug.Print "Error " & Err.Number & ": " & Err.Description
On Error GoTo 0
Exit Sub
End If
'// 응답 상태 코드 가져오기
status = xmlhttp.status
'// 응답 텍스트 가져오기
GetresponseText = xmlhttp.responseText
'// JSON 파싱
Set jsonObject = JsonConverter.ParseJson(GetresponseText)
j = 1
'// JSON 파싱
Set jsonObject = JsonConverter.ParseJson(GetresponseText)
For Each jsonItem In jsonObject("value")
Worksheets("WTPartInfo").Cells(j + 8, "A") = j
Worksheets("WTPartInfo").Cells(j + 8, "B") = jsonItem("ID")
Worksheets("WTPartInfo").Cells(j + 8, "C") = jsonItem("Name")
Worksheets("WTPartInfo").Cells(j + 8, "D") = jsonItem("Number")
Worksheets("WTPartInfo").Cells(j + 8, "E") = jsonItem("PARTNO")
Worksheets("WTPartInfo").Cells(j + 8, "F") = jsonItem("PARTNAME")
Worksheets("WTPartInfo").Cells(j + 8, "G") = jsonItem("MATERIAL")
j = j + 1
Next jsonItem
Set xmlhttp = Nothing
End Sub
'VBA For Windchill' 카테고리의 다른 글
| Windchill & VBA 05) Create WTPart #2 - 작업중 (0) | 2024.08.28 |
|---|---|
| Program to get product and base folder IDs (0) | 2024.08.24 |
| This is a program that retrieves the torken value from Windchill. (0) | 2024.08.21 |
| Windchill & VBA 05) Create WTPart #1 - 작업중 (0) | 2024.08.05 |
| Windchill & VBA 10) Retrieving Folder Contents of a Specific Type (0) | 2024.08.03 |
