본문 바로가기
  • 환영 합니다 ! Welcome!
VBA For Creo

Windchill & VBA 03) Creating a WTPart (부품)

by ToolBOX01 2024. 6. 26.
반응형

코드

Option Explicit
Sub CreatePart0001()
    Dim xmlhttp As Object
    Dim url As String
    Dim nonce As String
    Dim requestBody As String
    Dim responseText As String
    Dim status As Integer
    
    '// JOSN 파일 읽기
    Dim FSO As New FileSystemObject
    Dim JsonTS As TextStream
    Set JsonTS = FSO.OpenTextFile("C:\PTC\WORK90\example.JSON ", ForReading)
    requestBody = JsonTS.ReadAll
    
    '// URL 및 NONCE 값 설정
    url = "http://plm.******.com/Windchill/servlet/odata/ProdMgmt/Parts"
    nonce = "*****
   
    '// XMLHTTP 객체 생성
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP.6.0")
    
    '// 서버와의 연결 열기
    xmlhttp.Open "POST", url, False
    
    '//요청 헤더 설정
    
    xmlhttp.SetRequestHeader "Content-Type", "application/json"
    xmlhttp.SetRequestHeader "CSRF_NONCE", nonce
    
    ' 오류 발생 시 오류 메시지 출력
    On Error Resume Next
    
    
    ' 요청 보내기
    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
    
    ' 응답 텍스트 가져오기
    responseText = xmlhttp.responseText
    
    ' 응답 상태 및 텍스트 출력 (디버깅 용도)
    Debug.Print "Status: " & status
    Debug.Print "Response: " & responseText
    
    ' 정리 작업
    Set xmlhttp = Nothing
End Sub

json 파일에 오류가 있습니다

{
    "Name": "DEMO-0001",
    "AssemblyMode": {
        "Value": "separable",
        "Display": "Separable"
    },
    "EndItem": false,
    "DefaultUnit": "each",
    "DefaultTraceCode": "Untraced",
    "GatheringPart": false,
    "Source": "Make",
    "ServiceKit": false,
    "DefaultServiceable": true,
    "StopEffectivityPropagation": true,
    "PhantomManufacturingPart": false,
    "Context@odata.bind": "Containers('OR:wt.pdmlink.PDMLinkProduct:Demo')"
}