1 はじめに
1.1 何をするものなのか
JpoApiClassとは、日本国特許庁が提供する12個の特許情報取得APIをExcel上で取り扱えるようにした VBAクラスです。これに基いて、特許情報取得APIを取り扱うExcelマクロを組むことができます。
特許情報取得APIについては以下をご参照ください。なお、特許情報取得APIを使用するためには、特許庁が発行した ID とバスワードとトークンパスが必要です。
1.2 ダウンロード先
以下の OSDNのサイトから、Excelファイル "JpoApiTest_xxxxxx.xlsm" をダウンロードしてください。
1.3 動作環境
Excel2019 と Windows10 Pro/Home の組み合わせの環境で動作確認しています。
1.4 インストール方法
Excelのマクロ有効ファイルとしてご提供しています。特段のインストール手順は不要です。
2 JpoApiClass
2.1 JpoApiClassの概要
特許情報取得API用VBAクラスは、JpoApiClass として記載されています。
以下の表は、JpoApiClass の関数の名称と概要を示したものです。関数名はGet+(APIのキャメルケース)としています。
| 名称 | 概要 | 関数とその引数 |
|---|---|---|
| トークン取得 | アクセストークンの取得 | GetToken(username,password) |
| トークン更新 | アクセストークンの更新 | RefreshToken(refresh_token) |
| 特許経過情報 | 出願番号に基づき経過情報の一覧を取得 | GetApiClass(出願番号) |
| シンプル版特許経過情報 | シンプルな経過情報の一覧を取得 | GetAppProgressSimple(出願番号) |
| 特許分割出願情報 | 出願番号に基づき分割出願情報を取得 | GetDivisionalAppInfo(出願番号) |
| 特許優先基礎出願情報 | 出願番号に基づき優先基礎出願情報を取得 | GetPriorityRightAppInfo(出願番号) |
| 特許申請人氏名・名称 | 申請人コードに基づき申請人氏名・名称を取得 | GetApplicantAttorneyCd(申請人コード) |
| 特許申請人コード | 申請人氏名・名称に基づき申請人コードを取得 | GetApplicantAttorney(申請人氏名・名称) |
| 特許番号参照 | 出願/公開/登録番号に基づき相互に番号を取得 | GetCaseNumberReference(種別,案件番号) |
| 特許申請書類 | 出願番号に基づき特許申請書類の実体ファイルを取得 | GetAppDocContOpinionAmendment(出願番号) |
| 特許発送書類 | 出願番号に基づき特許発送書類の実体ファイルを取得 | GetAppDocContRefusalReasonDecision(出願番号) |
| 特許拒絶理由通知書 | 出願番号に基づき拒絶理由通知書を取得 | GetAppDocContRefusalReason(出願番号) |
| 特許引用文献情報取得 | 出願番号に基づき拒絶理由の引用文献情報を取得 | GetCiteDocInfo(出願番号) |
| 特許登録情報 | 出願番号に基づき登録情報を取得 | GetRegistrationInfo(出願番号) |
メンバー変数は以下です。
| メンバー変数 | 意味 | 型 |
|---|---|---|
| userName | ユーザ名 | String |
| password | パスワード | String |
| tokenpath | トークンパス | String |
| access_token | アクセストークン | String |
| m_t_httpget | http get に要した時間 | Double |
| m_t_parse | Jsonの解析に要した時間 | Double |
| m_response | http getで取得したオブジェクト | Object |
| m_response.Status | httpステータス | - |
なお、JpoApiClassは、VBA-JSON を用いることが前提となっています。OSDNにリリースしているExcelファイルには、VBA-JSONを組み込んでいます。
2.2 JpoApiClassの詳細
2.2.1 トークン取得と更新
アクセストークンの取得と、アクセストークンのリフレッシュ（更新）をテストするためのシートです。他の全てのAPIを実行する前に実行してください。
"JpoApiTest_xxxxxx.xlsm"のトークン取得シートのB1セルに特許庁が発行したIDを、B2セルに特許庁が発行したバスワード、B3セルに特許庁から通知されたトークンパスを設定してください。
なおトークンパスとは、https://ip-data.jpo.go.jp に続くパス名であり、'/'から始まる文字列です。
GetTokenの戻り値は、JpoApiClass（Object型）です。GetToken(id,password) を呼び出すテストコードは以下です。
Public Sub JPO_TOKEN_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objAuthToken As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z1024").Clear
Range("A4:Z1024").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.tokenpath = Range("B3").Value
Set objAuthToken = objJpoApi.GetToken(Range("B1").Value, Range("B2").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objAuthToken Is Nothing) Then
iCol = iCol + 1
If objAuthToken.Exists("access_token") Then
Cells(iCol, 1).Value = "access_token"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("access_token")
iCol = iCol + 1
End If
If objAuthToken.Exists("expires_in") Then
Cells(iCol, 1).Value = "expires_in"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("expires_in")
iCol = iCol + 1
End If
If objAuthToken.Exists("refresh_expires_in") Then
Cells(iCol, 1).Value = "refresh_expires_in"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("refresh_expires_in")
iCol = iCol + 1
End If
If objAuthToken.Exists("refresh_token") Then
Cells(iCol, 1).Value = "refresh_token"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("refresh_token")
iCol = iCol + 1
End If
If objAuthToken.Exists("token_type") Then
Cells(iCol, 1).Value = "token_type"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("token_type")
iCol = iCol + 1
End If
If objAuthToken.Exists("not-before-policy") Then
Cells(iCol, 1).Value = "not-before-policy"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("not-before-policy")
iCol = iCol + 1
End If
If objAuthToken.Exists("session_state") Then
Cells(iCol, 1).Value = "session_state"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("session_state")
iCol = iCol + 1
End If
If objAuthToken.Exists("scope") Then
Cells(iCol, 1).Value = "scope"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("scope")
iCol = iCol + 1
End If
End If
Set objJpoApi = Nothing
End Sub
GetToken(id,password)は以下です。
'---------------------------------------------------------------------------
' トークンを取得
'
Public Function GetToken(userName As String, password As String) As Object
Set GetToken = Nothing
m_t_httpget = 0
Dim szKeyValues(2) As String
szKeyValues(0) = "grant_type=password"
szKeyValues(1) = "username=" & userName
szKeyValues(2) = "password=" & password
m_t_httpget = GetMicroSecond()
Set m_response = m_objHttp.PostData3(JPOAPI_HOST & m_tokenPath, szKeyValues)
m_t_httpget = GetMicroSecond() - m_t_httpget
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetToken = JsonConverter.ParseJson(m_response.responseText)
If GetToken.Exists("access_token") Then
m_access_token = GetToken.Item("access_token")
End If
If GetToken.Exists("refresh_token") Then
m_refresh_token = GetToken.Item("refresh_token")
End If
If GetToken.Exists("token_type") Then
m_token_type = GetToken.Item("token_type")
End If
m_t_parse = GetMicroSecond() - m_t_parse
End If
End If
End Function
RefreshToken(refresh_token) を呼び出すテストコードは以下です。
Public Sub JPO_REFRESH_TOKEN_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objAuthToken As Object
Dim iCol As Long
Dim iRow As Long
Dim refresh_token As String
refresh_token = Range("B11").Value
Range("A4:Z1024").Clear
Range("A4:Z1024").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.tokenpath = Range("B3").Value
Set objAuthToken = objJpoApi.RefreshToken(refresh_token)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objAuthToken Is Nothing) Then
iCol = iCol + 1
If objAuthToken.Exists("access_token") Then
Cells(iCol, 1).Value = "access_token"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("access_token")
iCol = iCol + 1
End If
If objAuthToken.Exists("expires_in") Then
Cells(iCol, 1).Value = "expires_in"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("expires_in")
iCol = iCol + 1
End If
If objAuthToken.Exists("refresh_expires_in") Then
Cells(iCol, 1).Value = "refresh_expires_in"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("refresh_expires_in")
iCol = iCol + 1
End If
If objAuthToken.Exists("refresh_token") Then
Cells(iCol, 1).Value = "refresh_token"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("refresh_token")
iCol = iCol + 1
End If
If objAuthToken.Exists("token_type") Then
Cells(iCol, 1).Value = "token_type"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("token_type")
iCol = iCol + 1
End If
If objAuthToken.Exists("not-before-policy") Then
Cells(iCol, 1).Value = "not-before-policy"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("not-before-policy")
iCol = iCol + 1
End If
If objAuthToken.Exists("session_state") Then
Cells(iCol, 1).Value = "session_state"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("session_state")
iCol = iCol + 1
End If
If objAuthToken.Exists("scope") Then
Cells(iCol, 1).Value = "scope"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objAuthToken.Item("scope")
iCol = iCol + 1
End If
End If
Set objJpoApi = Nothing
End Sub
RefreshToken(refresh_token)は以下です。
'---------------------------------------------------------------------------
' トークンを更新
'
Public Function RefreshToken(Optional a_refresh_token As String = "") As Object
Set RefreshToken = Nothing
m_t_httpget = 0
Dim szKeyValues(1) As String
szKeyValues(0) = "grant_type=refresh_token"
If Len(a_refresh_token) <> 0 Then
szKeyValues(1) = "refresh_token=" & a_refresh_token
Else
szKeyValues(1) = "refresh_token=" & m_refresh_token
End If
m_t_httpget = GetMicroSecond()
Set m_response = m_objHttp.PostData3(JPOAPI_HOST & m_tokenPath, szKeyValues)
m_t_httpget = GetMicroSecond() - m_t_httpget
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set RefreshToken = JsonConverter.ParseJson(m_response.responseText)
If RefreshToken.Exists("access_token") Then
m_access_token = RefreshToken.Item("access_token")
End If
If RefreshToken.Exists("refresh_token") Then
m_refresh_token = RefreshToken.Item("refresh_token")
End If
If RefreshToken.Exists("token_type") Then
m_token_type = RefreshToken.Item("token_type")
End If
m_t_parse = GetMicroSecond() - m_t_parse
End If
End If
End Function
2.2.2 特許経過情報
"JpoApiTest_xxxxxx.xlsm"の特許経過情報シートは、出願番号に基づき経過情報の一覧を取得するGetAppProgess関数をテストするためのものです。
特許経過情報シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
GetAppProgress(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許経過情報取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_APP_PROGRESS_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetAppProgress(Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("inventionTitle") Then
Cells(iCol, 2).Value = "発明名称"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("inventionTitle")
iCol = iCol + 1
End If
If objData.Exists("applicantAttorney") Then
Cells(iCol, 2).Value = "申請人（出願人・代理人）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
iCol = iCol + 1
Dim objApplicantAttorney As Variant
For Each objApplicantAttorney In objData.Item("applicantAttorney")
If objApplicantAttorney.Exists("applicantAttorneyCd") Then
Cells(iCol, 3).Value = "申請人コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("applicantAttorneyCd")
iCol = iCol + 1
End If
If objApplicantAttorney.Exists("repeatNumber") Then
Cells(iCol, 3).Value = "繰返番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("repeatNumber")
iCol = iCol + 1
End If
If objApplicantAttorney.Exists("name") Then
Cells(iCol, 3).Value = "申請人氏名・名称"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("name")
iCol = iCol + 1
End If
If objApplicantAttorney.Exists("applicantAttorneyClass") Then
Cells(iCol, 3).Value = "出願人・代理人識別"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("applicantAttorneyClass")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
If objData.Exists("fillingDate") Then
Cells(iCol, 2).Value = "出願日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("fillingDate")
iCol = iCol + 1
End If
If objData.Exists("publicationNumber") Then
Cells(iCol, 2).Value = "公開番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("publicationNumber")
iCol = iCol + 1
End If
If objData.Exists("ADPublicationNumber") Then
Cells(iCol, 2).Value = "公開番号（西暦変換）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("ADPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("nationalPublicationNumber") Then
Cells(iCol, 2).Value = "公表番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("nationalPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("ADNationalPublicationNumber") Then
Cells(iCol, 2).Value = "公表番号（西暦変換）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("ADNationalPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("publicationDate") Then
Cells(iCol, 2).Value = "公開日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("publicationDate")
iCol = iCol + 1
End If
If objData.Exists("registrationNumber") Then
Cells(iCol, 2).Value = "登録番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationNumber")
iCol = iCol + 1
End If
If objData.Exists("registrationDate") Then
Cells(iCol, 2).Value = "登録日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationDate")
iCol = iCol + 1
End If
If objData.Exists("erasureIdentifier") Then
Cells(iCol, 2).Value = "抹消識別"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("erasureIdentifier")
iCol = iCol + 1
End If
If objData.Exists("expireDate") Then
Cells(iCol, 2).Value = "存続期間満了年月日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("expireDate")
iCol = iCol + 1
End If
If objData.Exists("disappearanceDate") Then
Cells(iCol, 2).Value = "本権利消滅日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("disappearanceDate")
iCol = iCol + 1
End If
If objData.Exists("priorityRightInformation") Then
Cells(iCol, 2).Value = "優先権基礎情報"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objPriorityRightInformation As Variant
For Each objPriorityRightInformation In objData.Item("priorityRightInformation")
If objPriorityRightInformation.Exists("applicantAttorneyId") Then
Cells(iCol, 3).Value = "パリ条約に基づく優先権出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("parisPriorityApplicationNumber")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("parisPriorityDate") Then
Cells(iCol, 3).Value = "パリ条約に基づく優先権主張日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("parisPriorityDate")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("parisPriorityCountryCd") Then
Cells(iCol, 3).Value = "パリ条約に基づく優先権国コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("parisPriorityCountryCd")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("nationalPriorityLawCd") Then
Cells(iCol, 3).Value = "国内優先権四法コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("nationalPriorityLawCd")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("nationalPriorityApplicationNumber") Then
Cells(iCol, 3).Value = "国内優先権出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("nationalPriorityApplicationNumber")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("nationalPriorityInternationalApplicationNumber") Then
Cells(iCol, 3).Value = "国内優先権国際出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("nationalPriorityInternationalApplicationNumber")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("nationalPriorityDate") Then
Cells(iCol, 3).Value = "国内優先権主張日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("nationalPriorityDate")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
If objData.Exists("parentApplicationInformation") Then
Cells(iCol, 2).Value = "原出願情報"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objParentApplicationInformation As Variant
Set objParentApplicationInformation = objData.Item("parentApplicationInformation")
If objParentApplicationInformation.Exists("applicationNumber") Then
Cells(iCol, 3).Value = "原出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objParentApplicationInformation.Item("applicationNumber")
iCol = iCol + 1
End If
If objParentApplicationInformation.Exists("publicationNumber") Then
Cells(iCol, 3).Value = "出願日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objParentApplicationInformation.Item("publicationNumber")
iCol = iCol + 1
End If
End If
If objData.Exists("divisionalApplicationInformation") Then
Cells(iCol, 2).Value = "分割出願群情報"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objDivisionalApplicationInformation As Variant
For Each objDivisionalApplicationInformation In objData.Item("divisionalApplicationInformation")
If objDivisionalApplicationInformation.Exists("applicationNumber") Then
Cells(iCol, 3).Value = "出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("applicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("publicationNumber") Then
Cells(iCol, 3).Value = "公開番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("publicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("ADpublicationNumber") Then
Cells(iCol, 3).Value = "公開番号（西暦変換）"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("ADpublicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("nationalPublicationNumber") Then
Cells(iCol, 3).Value = "公表番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("nationalPublicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("ADNationalPublicationNumber") Then
Cells(iCol, 3).Value = "公表番号（西暦変換）"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("ADNationalPublicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("registrationNumber") Then
Cells(iCol, 3).Value = "登録番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("registrationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("erasureIdentifier") Then
Cells(iCol, 3).Value = "抹消識別"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("erasureIdentifier")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("expireDate") Then
Cells(iCol, 3).Value = "存続期間満了年月日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("expireDate")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("disappearanceDate") Then
Cells(iCol, 3).Value = "本権利消滅日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("disappearanceDate")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("divisionalGeneration") Then
Cells(iCol, 3).Value = "分割出願の世代"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("divisionalGeneration")
iCol = iCol + 1
End If
Next
End If
If objData.Exists("bibliographyInformation") Then
Cells(iCol, 2).Value = "書類一覧（書誌）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objBibliographyInformation As Variant
For Each objBibliographyInformation In objData.Item("bibliographyInformation")
If objBibliographyInformation.Exists("numberType") Then
Cells(iCol, 3).Value = "番号種別"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objBibliographyInformation.Item("numberType")
iCol = iCol + 1
End If
If objBibliographyInformation.Exists("number") Then
Cells(iCol, 3).Value = "番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objBibliographyInformation.Item("number")
iCol = iCol + 1
End If
If objBibliographyInformation.Exists("documentList") Then
Cells(iCol, 3).Value = "書類一覧"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Dim objDocumentList As Object
For Each objDocumentList In objBibliographyInformation.Item("documentList")
If objDocumentList.Exists("legalDate") Then
Cells(iCol, 4).Value = "受付日・発送日・作成日"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("legalDate")
iCol = iCol + 1
End If
If objDocumentList.Exists("irirFlg") Then
Cells(iCol, 4).Value = "中間書類コード"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("irirFlg")
iCol = iCol + 1
End If
If objDocumentList.Exists("availabilityFlag") Then
Cells(iCol, 4).Value = "書類実体有無"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("availabilityFlag")
iCol = iCol + 1
End If
If objDocumentList.Exists("documentCode") Then
Cells(iCol, 4).Value = "中間書類コード"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("documentCode")
iCol = iCol + 1
End If
If objDocumentList.Exists("documentDescription") Then
Cells(iCol, 4).Value = "書類名"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("documentDescription")
iCol = iCol + 1
End If
If objDocumentList.Exists("documentNumber") Then
Cells(iCol, 4).Value = "書類番号"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("documentNumber")
iCol = iCol + 1
End If
If objDocumentList.Exists("versionNumber") Then
Cells(iCol, 4).Value = "バージョン番号"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("versionNumber")
iCol = iCol + 1
End If
If objDocumentList.Exists("documentSeparator") Then
Cells(iCol, 4).Value = "書類識別"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("documentSeparator")
iCol = iCol + 1
End If
If objDocumentList.Exists("numberOfPages") Then
Cells(iCol, 4).Value = "ページ数"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("numberOfPages")
iCol = iCol + 1
End If
If objDocumentList.Exists("sizeOfDocument") Then
Cells(iCol, 4).Value = "ドキュメントサイズ"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("sizeOfDocument")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
Next
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetAppProgress(出願番号)は以下です。
'---------------------------------------------------------------------------
' 特許経過情報を取得 : app_progress
'
Public Function GetAppProgress(requestNumber As String, Optional aVersion As String = "v1") As Object
Set GetAppProgress = Nothing
m_t_httpget = 0
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/app_progress/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetAppProgress = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.3 シンプル版特許経過情報
"JpoApiTest_xxxxxx.xlsm"のシンプル版特許経過情報シートは、シンプルな経過情報の一覧を取得するGetAppProgressSimple関数をテストします。
シンプル版特許経過情報シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
GetAppProgressSimple(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API シンプル版特許経過情報取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_APP_PROGRESS_SIMPLE_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetAppProgressSimple(Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("inventionTitle") Then
Cells(iCol, 2).Value = "発明名称"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("inventionTitle")
iCol = iCol + 1
End If
If objData.Exists("applicantAttorney") Then
Cells(iCol, 2).Value = "申請人（出願人・代理人）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
iCol = iCol + 1
Dim objApplicantAttorney As Variant
For Each objApplicantAttorney In objData.Item("applicantAttorney")
If objApplicantAttorney.Exists("applicantAttorneyCd") Then
Cells(iCol, 3).Value = "申請人コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("applicantAttorneyCd")
iCol = iCol + 1
End If
If objApplicantAttorney.Exists("repeatNumber") Then
Cells(iCol, 3).Value = "繰返番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("repeatNumber")
iCol = iCol + 1
End If
If objApplicantAttorney.Exists("name") Then
Cells(iCol, 3).Value = "申請人氏名・名称"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("name")
iCol = iCol + 1
End If
If objApplicantAttorney.Exists("applicantAttorneyClass") Then
Cells(iCol, 3).Value = "出願人・代理人識別"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("applicantAttorneyClass")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
If objData.Exists("fillingDate") Then
Cells(iCol, 2).Value = "出願日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("fillingDate")
iCol = iCol + 1
End If
If objData.Exists("publicationNumber") Then
Cells(iCol, 2).Value = "公開番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("publicationNumber")
iCol = iCol + 1
End If
If objData.Exists("ADPublicationNumber") Then
Cells(iCol, 2).Value = "公開番号（西暦変換）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("ADPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("nationalPublicationNumber") Then
Cells(iCol, 2).Value = "公表番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("nationalPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("ADNationalPublicationNumber") Then
Cells(iCol, 2).Value = "公表番号（西暦変換）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("ADNationalPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("publicationDate") Then
Cells(iCol, 2).Value = "公開日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("publicationDate")
iCol = iCol + 1
End If
If objData.Exists("registrationNumber") Then
Cells(iCol, 2).Value = "登録番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationNumber")
iCol = iCol + 1
End If
If objData.Exists("registrationDate") Then
Cells(iCol, 2).Value = "登録日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationDate")
iCol = iCol + 1
End If
If objData.Exists("erasureIdentifier") Then
Cells(iCol, 2).Value = "抹消識別"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("erasureIdentifier")
iCol = iCol + 1
End If
If objData.Exists("expireDate") Then
Cells(iCol, 2).Value = "存続期間満了年月日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("expireDate")
iCol = iCol + 1
End If
If objData.Exists("disappearanceDate") Then
Cells(iCol, 2).Value = "本権利消滅日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("disappearanceDate")
iCol = iCol + 1
End If
If objData.Exists("bibliographyInformation") Then
Cells(iCol, 2).Value = "書類一覧（書誌）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objBibliographyInformation As Variant
For Each objBibliographyInformation In objData.Item("bibliographyInformation")
If objBibliographyInformation.Exists("numberType") Then
Cells(iCol, 3).Value = "番号種別"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objBibliographyInformation.Item("numberType")
iCol = iCol + 1
End If
If objBibliographyInformation.Exists("number") Then
Cells(iCol, 3).Value = "番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objBibliographyInformation.Item("number")
iCol = iCol + 1
End If
If objBibliographyInformation.Exists("documentList") Then
Cells(iCol, 3).Value = "書類一覧"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Dim objDocumentList As Object
For Each objDocumentList In objBibliographyInformation.Item("documentList")
If objDocumentList.Exists("legalDate") Then
Cells(iCol, 4).Value = "受付日・発送日・作成日"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("legalDate")
iCol = iCol + 1
End If
If objDocumentList.Exists("irirFlg") Then
Cells(iCol, 4).Value = "中間書類コード"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("irirFlg")
iCol = iCol + 1
End If
If objDocumentList.Exists("availabilityFlag") Then
Cells(iCol, 4).Value = "書類実体有無"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("availabilityFlag")
iCol = iCol + 1
End If
If objDocumentList.Exists("documentCode") Then
Cells(iCol, 4).Value = "中間書類コード"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("documentCode")
iCol = iCol + 1
End If
If objDocumentList.Exists("documentDescription") Then
Cells(iCol, 4).Value = "書類名"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("documentDescription")
iCol = iCol + 1
End If
If objDocumentList.Exists("documentNumber") Then
Cells(iCol, 4).Value = "書類番号"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("documentNumber")
iCol = iCol + 1
End If
If objDocumentList.Exists("versionNumber") Then
Cells(iCol, 4).Value = "バージョン番号"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("versionNumber")
iCol = iCol + 1
End If
If objDocumentList.Exists("documentSeparator") Then
Cells(iCol, 4).Value = "書類識別"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("documentSeparator")
iCol = iCol + 1
End If
If objDocumentList.Exists("numberOfPages") Then
Cells(iCol, 4).Value = "ページ数"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("numberOfPages")
iCol = iCol + 1
End If
If objDocumentList.Exists("sizeOfDocument") Then
Cells(iCol, 4).Value = "ドキュメントサイズ"
Cells(iCol, 4).Font.Color = RGB(128, 0, 0)
Cells(iCol, 5).Value = objDocumentList.Item("sizeOfDocument")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
Next
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetAppProgressSimple(出願番号)は以下です。
'---------------------------------------------------------------------------
' シンプル版特許経過情報を取得 : app_progress_simple
'
Public Function GetAppProgressSimple(requestNumber As String, Optional aVersion As String = "v1") As Object
Set GetAppProgressSimple = Nothing
m_t_httpget = 0
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/app_progress_simple/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetAppProgressSimple = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.4 特許分割出願情報
"JpoApiTest_xxxxxx.xlsm"の特許分割出願情報シートは、出願番号に基づき分割出願情報を取得するGetDivisionalAppInfo関数をテストします。
特許分割出願情報シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
GetDivisionalAppInfo(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API－特許分割出願情報取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_DIVISIONAL_APP_INFO_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetDivisionalAppInfo(Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("parentApplicationInformation") Then
Cells(iCol, 2).Value = "原出願情報"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objParentApplicationInformation As Variant
Set objParentApplicationInformation = objData.Item("parentApplicationInformation")
If objParentApplicationInformation.Exists("applicationNumber") Then
Cells(iCol, 3).Value = "原出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objParentApplicationInformation.Item("applicationNumber")
iCol = iCol + 1
End If
If objParentApplicationInformation.Exists("publicationNumber") Then
Cells(iCol, 3).Value = "出願日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objParentApplicationInformation.Item("publicationNumber")
iCol = iCol + 1
End If
End If
If objData.Exists("divisionalApplicationInformation") Then
Cells(iCol, 2).Value = "分割出願群情報"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objDivisionalApplicationInformation As Variant
For Each objDivisionalApplicationInformation In objData.Item("divisionalApplicationInformation")
If objDivisionalApplicationInformation.Exists("applicationNumber") Then
Cells(iCol, 3).Value = "出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("applicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("publicationNumber") Then
Cells(iCol, 3).Value = "公開番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("publicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("ADpublicationNumber") Then
Cells(iCol, 3).Value = "公開番号（西暦変換）"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("ADpublicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("nationalPublicationNumber") Then
Cells(iCol, 3).Value = "公表番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("nationalPublicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("ADNationalPublicationNumber") Then
Cells(iCol, 3).Value = "公表番号（西暦変換）"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("ADNationalPublicationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("registrationNumber") Then
Cells(iCol, 3).Value = "登録番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("registrationNumber")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("erasureIdentifier") Then
Cells(iCol, 3).Value = "抹消識別"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("erasureIdentifier")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("expireDate") Then
Cells(iCol, 3).Value = "存続期間満了年月日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("expireDate")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("disappearanceDate") Then
Cells(iCol, 3).Value = "本権利消滅日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("disappearanceDate")
iCol = iCol + 1
End If
If objDivisionalApplicationInformation.Exists("divisionalGeneration") Then
Cells(iCol, 3).Value = "分割出願の世代"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objDivisionalApplicationInformation.Item("divisionalGeneration")
iCol = iCol + 1
End If
Next
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetDivisionalAppInfo(出願番号)は以下です。
'---------------------------------------------------------------------------
' 特許分割出願情報を取得 : divisional_app_info
'
Public Function GetDivisionalAppInfo(requestNumber As String, Optional ByRef aVersion As String = "v1") As Object
Set GetDivisionalAppInfo = Nothing
m_t_httpget = 0
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/divisional_app_info/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetDivisionalAppInfo = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.5 特許優先基礎出願情報
"JpoApiTest_xxxxxx.xlsm"の特許優先基礎出願情報シートは、出願番号に基づき優先基礎出願情報を取得するGetPriorityRightAppInfo関数をテストします。
特許優先基礎出願情報シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
GetPriorityRightAppInfo(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許優先基礎出願情報取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_PRIORITY_RIGHT_APP_INFO_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetPriorityRightAppInfo(Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("priorityRightInformation") Then
Cells(iCol, 2).Value = "優先権基礎情報"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objPriorityRightInformation As Variant
For Each objPriorityRightInformation In objData.Item("priorityRightInformation")
If objPriorityRightInformation.Exists("applicantAttorneyId") Then
Cells(iCol, 3).Value = "パリ条約に基づく優先権出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("parisPriorityApplicationNumber")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("parisPriorityDate") Then
Cells(iCol, 3).Value = "パリ条約に基づく優先権主張日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("parisPriorityDate")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("parisPriorityCountryCd") Then
Cells(iCol, 3).Value = "パリ条約に基づく優先権国コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("parisPriorityCountryCd")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("nationalPriorityLawCd") Then
Cells(iCol, 3).Value = "国内優先権四法コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("nationalPriorityLawCd")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("nationalPriorityApplicationNumber") Then
Cells(iCol, 3).Value = "国内優先権出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("nationalPriorityApplicationNumber")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("nationalPriorityInternationalApplicationNumber") Then
Cells(iCol, 3).Value = "国内優先権国際出願番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("nationalPriorityInternationalApplicationNumber")
iCol = iCol + 1
End If
If objPriorityRightInformation.Exists("nationalPriorityDate") Then
Cells(iCol, 3).Value = "国内優先権主張日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPriorityRightInformation.Item("nationalPriorityDate")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetPriorityRightAppInfo(出願番号)は以下です。
'---------------------------------------------------------------------------
' 特許優先基礎出願情報を取得 : priority_right_app_info
'
Public Function GetPriorityRightAppInfo(requestNumber As String, Optional aVersion As String = "v1") As Object
Set GetPriorityRightAppInfo = Nothing
m_t_httpget = 0
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/priority_right_app_info/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetPriorityRightAppInfo = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.6 特許申請人氏名・名称
"JpoApiTest_xxxxxx.xlsm"の特許申請人氏名・名称シートは、申請人コードに基づき申請人氏名・名称を取得する GetApplicantAttorneyCd関数をテストします。
特許申請人氏名・名称シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
GetApplicantAttorneyCd(申請人コード) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許申請人氏名・名称取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_APPLICANT_ATTORNEY_CD_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objApplicant As Object
Dim iCol As Long
Dim iRow As Long
Dim objResponse As Object
Range("A4:Z1024").Clear
Range("A4:Z1024").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objApplicant = objJpoApi.GetApplicantAttorneyCd(Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objApplicant Is Nothing) Then
If objApplicant.Exists("result") Then
Dim objResult As Object
Set objResult = objApplicant.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
iCol = iCol + 1
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicantAttorneyName") Then
Cells(iCol, 1).Value = "申請人氏名・名称（出願人・代理人）"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objData.Item("applicantAttorneyName")
iCol = iCol + 1
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetApplicantAttorneyCd(申請人コード)は以下です。
'------------------------------------------------------------------------
' 特許申請人氏名・名称を取得 applicant_attorney_cd
'
Public Function GetApplicantAttorneyCd(applicantAttorneyCd As String, Optional aVersion As String = "v1") As Object
Set GetApplicantAttorneyCd = Nothing
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/applicant_attorney_cd/" & applicantAttorneyCd)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetApplicantAttorneyCd = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.7 特許申請人コード
"JpoApiTest_xxxxxx.xlsm"の特許申請人コードシートは、申請人氏名・名称に基づき申請人コードを取得する GetApplicantAttorney関数をテストします。
特許申請人コードシートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
GetApplicantAttorney(申請人名称) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許申請人コード取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_APPLICANT_ATTORNEY_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objApplicant As Object
Dim iCol As Long
Dim iRow As Long
'Dim objResponse As Object
Range("A4:Z1024").Clear
Range("A4:Z1024").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objApplicant = objJpoApi.GetApplicantAttorney(Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objApplicant Is Nothing) Then
If objApplicant.Exists("result") Then
Dim objResult As Object
Set objResult = objApplicant.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
'If objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
iCol = iCol + 1
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicantAttorney") Then
Cells(iCol, 2).Value = "申請人（出願人・代理人）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objApplicantAttorney As Variant
For Each objApplicantAttorney In objData.Item("applicantAttorney")
If objApplicantAttorney.Exists("applicantAttorneyCd") Then
Cells(iCol, 3).Value = "申請人コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("applicantAttorneyCd")
iCol = iCol + 1
End If
If objApplicantAttorney.Exists("name") Then
Cells(iCol, 3).Value = "申請人氏名・名称"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objApplicantAttorney.Item("name")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetApplicantAttorney(申請人名称)は以下です。
'------------------------------------------------------------------------
' 特許申請人コードを取得 : applicant_attorney
'
Public Function GetApplicantAttorney(applicantAttorneyName As String, Optional aVersion As String = "v1") As Object
Set GetApplicantAttorney = Nothing
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/applicant_attorney/" & URL_Encode(applicantAttorneyName))
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetApplicantAttorney = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
'----------------------------------------------------------------------
' 出願人または代理人の名前をURL形式にエンコード
'
Function URL_Encode(ByVal strOrg As String) As String
With CreateObject("ScriptControl")
.Language = "JScript"
URL_Encode = .CodeObject.encodeURI(strOrg)
End With
End Function
2.2.8 特許番号参照
"JpoApiTest_xxxxxx.xlsm"の特許番号参照シートは、出願/公開/登録番号に基づき相互に番号を取得する GetCaseNumberReference関数をテストします。
特許番号参照シートのB1セルに出願番号を設定してください。
特許番号参照シートのB2セルに公開番号を設定してください。
特許番号参照シートのB3セルに登録番号を設定してください。
GetCaseNumberReference(”application”,出願番号)を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許番号参照APIのテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
'----------------------------------------------------------------------
' 出願番号指定のテスト
'----------------------------------------------------------------------
Public Sub JPO_CASE_NUMBER_REFERENCE_APPLICATION_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetCaseNumberReference("application", Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("publicationNumber") Then
Cells(iCol, 2).Value = "公開番号（西暦）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("publicationNumber")
iCol = iCol + 1
End If
If objData.Exists("nationalPublicationNumber") Then
Cells(iCol, 2).Value = "公表番号（西暦）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("nationalPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("registrationNumber") Then
Cells(iCol, 2).Value = "登録番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationNumber")
iCol = iCol + 1
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetCaseNumberReference("publication",公開番号) を呼び出すテストコードは以下です。
'----------------------------------------------------------------------
' 公開番号指定のテスト
'----------------------------------------------------------------------
Public Sub JPO_CASE_NUMBER_REFERENCE_PUBLICATION_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetCaseNumberReference("publication", Range("B2").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("publicationNumber") Then
Cells(iCol, 2).Value = "公開番号（西暦）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("publicationNumber")
iCol = iCol + 1
End If
If objData.Exists("nationalPublicationNumber") Then
Cells(iCol, 2).Value = "公表番号（西暦）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("nationalPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("registrationNumber") Then
Cells(iCol, 2).Value = "登録番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationNumber")
iCol = iCol + 1
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetCaseNumberReference("registration",登録番号) を呼び出すテストコードは以下です。
'----------------------------------------------------------------------
' 登録番号指定のテスト
'----------------------------------------------------------------------
Public Sub JPO_CASE_NUMBER_REFERENCE_REGISTRATION_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetCaseNumberReference("registration", Range("B3").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("publicationNumber") Then
Cells(iCol, 2).Value = "公開番号（西暦）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("publicationNumber")
iCol = iCol + 1
End If
If objData.Exists("nationalPublicationNumber") Then
Cells(iCol, 2).Value = "公表番号（西暦）"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("nationalPublicationNumber")
iCol = iCol + 1
End If
If objData.Exists("registrationNumber") Then
Cells(iCol, 2).Value = "登録番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationNumber")
iCol = iCol + 1
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetCaseNumberReference(種類,番号)は以下です。
'---------------------------------------------------------------------------
' 特許番号参照:case_number_reference
'
Public Function GetCaseNumberReference(caseOfNumber As String, requestNumber As String, Optional aVersion As String = "v1") As Object
Set GetCaseNumberReference = Nothing
m_t_httpget = 0
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/case_number_reference/" & caseOfNumber & "/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetCaseNumberReference = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.9 特許申請書類
"JpoApiTest_xxxxxx.xlsm"の特許申請書類シートは、出願番号に基づき特許申請書類の実体ファイルを取得するGetDocContOpinionAmendment関数をテストします。
特許申請書類シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
これにより、当該Excelファイル名本体と同一名のフォルダ下に (出願番号)_oa.zip のファイルがダウンロードされ、このフォルダ中に特許申請書類のXmlファイルが解凍されます。
GetDocContOpinionAmendment(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許申請書類（実体）取得APIのテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_APP_DOC_CONT_OPINION_AMENDMENT_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim filenameList() As Variant
Dim objResponse As Object
Dim objRefJson As Object
Dim iCol As Long
Dim iRow As Long
Dim path As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A4:Z1024").Clear
Range("A4:Z1024").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
path = ThisWorkbook.path & "\" & fso.GetBasename(ThisWorkbook.Name)
Set objRefJson = objJpoApi.GetDocContOpinionAmendment(Range("B1").Value, path, filenameList)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のZIP解凍時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_unzip
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のXML解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objRefJson Is Nothing) Then
If objRefJson.Exists("result") Then
Dim objResult As Object
Set objResult = objRefJson.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
End If
ElseIf UBound(filenameList) > 0 Then
Dim i As Integer
For i = LBound(filenameList) To UBound(filenameList) - 1
Cells(iCol, 1).Value = "申請書類"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = filenameList(i)
ActiveSheet.Hyperlinks.Add anchor:=Cells(iCol, 2), Address:=".\" & fso.GetBasename(ThisWorkbook.Name) & "\" & filenameList(i)
iCol = iCol + 1
Next i
End If
Set objJpoApi = Nothing
End Sub
GetDocContOpinionAmendment(出願番号)は以下です。
'---------------------------------------------------------------------------
' 特許申請書類（実体ファイル）を取得 : app_doc_cont_opinion_amendment
'
Public Function GetDocContOpinionAmendment(requestNumber As String, tempPath As String, ByRef filenameList() As Variant, Optional aVersion As String = "v1") As Object
ReDim filenameList(0)
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/app_doc_cont_opinion_amendment/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_unzip = GetMicroSecond()
' テンポラリフォルダ・パスに ZIPファイル生成
If Dir(tempPath, vbDirectory) = "" Then
MkDir tempPath
End If
' (出願番号)_oa.zip の仮ファイルを生成
Dim strFile As String
strFile = tempPath & "\" & requestNumber & "_oa.zip"
Dim oStream As Object
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.write m_response.responseBody
oStream.SaveToFile strFile, 2 ' 1 = no overwrite, 2 = overwrite"
oStream.Close
' ZIP内のファイル名リストの取得
Dim sh As Variant
Dim n As Variant
Set sh = CreateObject("Shell.Application")
Set n = sh.Namespace(tempPath & "\" & requestNumber & "_oa.zip")
ReDim Preserve filenameList(0)
Call GetFilenameList(sh, n, filenameList)
If UBound(filenameList) = 0 Then
Set GetDocContOpinionAmendment = JsonConverter.ParseJson(m_response.responseText)
Exit Function
End If
Set GetDocContOpinionAmendment = Nothing
' 全ファイルの展開
Call UnZip(strFile, tempPath, False)
m_t_unzip = GetMicroSecond() - m_t_unzip
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.10 特許発送書類
"JpoApiTest_xxxxxx.xlsm"の特許発送書類シートは、出願番号に基づき特許発送書類の実体ファイルを取得するGetDocContOpinionAmendment関数をテストします。
特許発送書類シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
これにより、当該Excelファイル名本体と同一名のフォルダ下に (出願番号)_rrd.zip のファイルがダウンロードされ、このフォルダ中に特許発送書類のXmlファイルが解凍されます。
GetDocContRefusalReasonDecision(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許発送書類（実体）取得APIのテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_APP_DOC_CONT_REFUSAL_REASON_DEC_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim filenameList() As Variant
Dim objResponse As Object
Dim objRefJson As Object
Dim iCol As Long
Dim iRow As Long
Dim path As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A4:Z1024").Clear
Range("A4:Z1024").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
path = ThisWorkbook.path & "\" & fso.GetBasename(ThisWorkbook.Name)
Set objRefJson = objJpoApi.GetDocContRefusalReasonDecision(Range("B1").Value, path, filenameList)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のZIP解凍時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_unzip
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のXML解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objRefJson Is Nothing) Then
If objRefJson.Exists("result") Then
Dim objResult As Object
Set objResult = objRefJson.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
End If
ElseIf UBound(filenameList) > 0 Then
Dim i As Integer
For i = LBound(filenameList) To UBound(filenameList) - 1
Cells(iCol, 1).Value = "発送書類"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = filenameList(i)
ActiveSheet.Hyperlinks.Add anchor:=Cells(iCol, 2), Address:=".\" & fso.GetBasename(ThisWorkbook.Name) & "\" & filenameList(i)
iCol = iCol + 1
Next i
End If
Set objJpoApi = Nothing
End Sub
GetDocContRefusalReasonDecision(出願番号)は以下です。
'---------------------------------------------------------------------------
' 特許発送書類（実体ファイル）を取得 : app_doc_cont_refusal_reason_decision
'
Public Function GetDocContRefusalReasonDecision(requestNumber As String, tempPath As String, ByRef filenameList() As Variant, Optional aVersion As String = "v1") As Object
ReDim Preserve filenameList(0)
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/app_doc_cont_refusal_reason_decision/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_unzip = GetMicroSecond()
' テンポラリフォルダ・パスに ZIPファイル生成
If Dir(tempPath, vbDirectory) = "" Then
MkDir tempPath
End If
' (出願番号)_rrd.zip の仮ファイルを生成
Dim strFile As String
strFile = tempPath & "\" & requestNumber & "_rrd.zip"
Dim oStream As Object
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.write m_response.responseBody
oStream.SaveToFile strFile, 2 ' 1 = no overwrite, 2 = overwrite"
oStream.Close
' ZIP内のファイル名リストの取得
Dim sh As Variant
Dim n As Variant
Set sh = CreateObject("Shell.Application")
Set n = sh.Namespace(tempPath & "\" & requestNumber & "_rrd.zip")
ReDim Preserve filenameList(0)
Call GetFilenameList(sh, n, filenameList)
If UBound(filenameList) = 0 Then
Set GetDocContRefusalReasonDecision = JsonConverter.ParseJson(m_response.responseText)
Exit Function
End If
Set GetDocContRefusalReasonDecision = Nothing
' 全ファイルの展開
Call UnZip(strFile, tempPath, False)
m_t_unzip = GetMicroSecond() - m_t_unzip
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.11 特許拒絶理由通知書
"JpoApiTest_xxxxxx.xlsm"の特許拒絶理由通知書シートは、出願番号に基づき拒絶理由通知書の実体を取得するGetDocContOpinionAmendment関数をテストします。
特許拒絶理由通知書シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
これにより、当該Excelファイル名本体と同一名のフォルダ下に (出願番号)_rr.zip のファイルがダウンロードされ、このフォルダ中に拒絶理由通知書のXmlファイルが解凍されます。
GetDocContRefusalReason(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許拒絶理由通知書（実体）取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_APP_DOC_CONT_REFUSAL_REASON_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim filenameList() As Variant
Dim objResponse As Object
Dim objRefJson As Object
Dim iCol As Long
Dim iRow As Long
Dim path As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A4:Z1024").Clear
Range("A4:Z1024").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
path = ThisWorkbook.path & "\" & fso.GetBasename(ThisWorkbook.Name)
Set objRefJson = objJpoApi.GetDocContRefusalReason(Range("B1").Value, path, filenameList)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のZIP解凍時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_unzip
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のXML解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objRefJson Is Nothing) Then
If objRefJson.Exists("result") Then
Dim objResult As Object
Set objResult = objRefJson.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
End If
ElseIf UBound(filenameList) > 0 Then
Dim i As Integer
For i = LBound(filenameList) To UBound(filenameList) - 1
Cells(iCol, 1).Value = "拒絶理由通知書"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = filenameList(i)
ActiveSheet.Hyperlinks.Add anchor:=Cells(iCol, 2), Address:=".\" & fso.GetBasename(ThisWorkbook.Name) & "\" & filenameList(i)
iCol = iCol + 1
Next i
End If
Set objJpoApi = Nothing
End Sub
GetDocContRefusalReason(出願番号)は以下です。
'---------------------------------------------------------------------------
' 拒絶理由通知書（実体）を取得 : app_doc_cont_refusal_reason
'
Public Function GetDocContRefusalReason(requestNumber As String, tempPath As String, ByRef filenameList() As Variant, Optional aVersion As String = "v1") As Object
ReDim Preserve filenameList(0)
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/app_doc_cont_refusal_reason/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_unzip = GetMicroSecond()
If Dir(tempPath, vbDirectory) = "" Then
MkDir tempPath
End If
' (出願番号)_rr.zip の仮ファイルを生成
Dim strFile As String
strFile = tempPath & "\" & requestNumber & "_rr.zip"
Dim oStream As Object
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.write m_response.responseBody
oStream.SaveToFile strFile, 2 ' 1 = no overwrite, 2 = overwrite"
oStream.Close
' ZIP内のファイル名リストの取得
Dim sh As Variant
Dim n As Variant
Set sh = CreateObject("Shell.Application")
Set n = sh.Namespace(tempPath & "\" & requestNumber & "_rr.zip")
'Dim filenameList() As Variant
ReDim Preserve filenameList(0)
Call GetFilenameList(sh, n, filenameList)
If UBound(filenameList) = 0 Then
Set GetDocContRefusalReason = JsonConverter.ParseJson(m_response.responseText)
Exit Function
End If
Set GetDocContRefusalReason = Nothing
' 全ファイルの展開
Call UnZip(strFile, tempPath, False)
m_t_unzip = GetMicroSecond() - m_t_unzip
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.12 特許引用文献情報
"JpoApiTest_xxxxxx.xlsm"の特許引用文献情報シートは、
出願番号に基づき拒絶理由の引用文献情報を取得するGetCiteDocInfo関数をテストします。
特許引用文献情報シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
GetCiteDocInfo(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許引用文献情報取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_CITE_DOC_INFO_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetCiteDocInfo(Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("patentDoc") Then
Cells(iCol, 2).Value = "特許文献情報データ"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objPatentDoc As Variant
For Each objPatentDoc In objData.Item("patentDoc")
If objPatentDoc.Exists("draftDate") Then
Cells(iCol, 3).Value = "起案日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPatentDoc.Item("draftDate")
iCol = iCol + 1
End If
If objPatentDoc.Exists("citationType") Then
Cells(iCol, 3).Value = "種別"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPatentDoc.Item("citationType")
iCol = iCol + 1
End If
If objPatentDoc.Exists("documentNumber") Then
Cells(iCol, 3).Value = "文献番号"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objPatentDoc.Item("documentNumber")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
If objData.Exists("nonPatentDoc") Then
Cells(iCol, 2).Value = "非特許文献情報データ"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Dim objNonPatentDoc As Variant
For Each objNonPatentDoc In objData.Item("nonPatentDoc")
If objNonPatentDoc.Exists("draftDate") Then
Cells(iCol, 3).Value = "起案日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("draftDate")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("citationType") Then
Cells(iCol, 3).Value = "種別"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("citationType")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("documentType") Then
Cells(iCol, 3).Value = "文献分類"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("documentType")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("authorName") Then
Cells(iCol, 3).Value = "著者/翻訳者名"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("authorName")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("paperTitle") Then
Cells(iCol, 3).Value = "論文名/タイトル"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("paperTitle")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("publicationName") Then
Cells(iCol, 3).Value = "刊行物名"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("publicationName")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("issueCountryCd") Then
Cells(iCol, 3).Value = "発行国コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("issueCountryCd")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("publisher") Then
Cells(iCol, 3).Value = "発行所／発行者"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("publisher")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("issueDate") Then
Cells(iCol, 3).Value = "発行／受入年月日日"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("issueDate")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("issueDateType") Then
Cells(iCol, 3).Value = "年月日フラグ"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("issueDateType")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("issueNumber") Then
Cells(iCol, 3).Value = "版数／巻／号数"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("issueNumber")
iCol = iCol + 1
End If
If objNonPatentDoc.Exists("citationPages") Then
Cells(iCol, 3).Value = "引用頁"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objNonPatentDoc.Item("citationPages")
iCol = iCol + 1
End If
iCol = iCol + 1
Next
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetCiteDocInfo(出願番号)は以下です。
'---------------------------------------------------------------------------
' 特許引用文献情報を取得 : cite_doc_info
'
Public Function GetCiteDocInfo(requestNumber As String, Optional aVersion As String = "v1") As Object
Set GetCiteDocInfo = Nothing
m_t_httpget = 0
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/cite_doc_info/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetCiteDocInfo = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
2.2.13 特許登録情報
"JpoApiTest_xxxxxx.xlsm"の特許登録情報シートは、出願番号に基づき登録情報を取得するGetRegistrationInfo関数をテストします。
特許登録情報シートのB1セルに出願番号を設定してください。なお出願番号は、西暦4桁と年度番号6桁の半角数字です。
GetRegistrationInfo(出願番号) を呼び出すテストコードは以下です。
Option Explicit
'----------------------------------------------------------------------
' 機能:日本国特許庁の特許情報取得API 特許登録情報取得のテスト
' Programmer: Ken'ichiro Ayaki(登録番号15532)
' 年月日:2022/1/29
' バージョン： ver.0.1.0
'----------------------------------------------------------------------
Public Sub JPO_REGISTRATION_INFO_TEST()
Dim objJpoApi As JpoApiClass
Set objJpoApi = New JpoApiClass
Dim objResponse As Object
Dim objJpo As Object
Dim iCol As Long
Dim iRow As Long
Range("A4:Z8192").Clear
Range("A4:Z8192").Font.Color = RGB(0, 0, 0)
iCol = 4
objJpoApi.access_token = Worksheets("トークン取得").Range("B8").Value
Set objJpo = objJpoApi.GetRegistrationInfo(Range("B1").Value)
If Not (objJpoApi.m_response Is Nothing) Then
Cells(iCol, 1).Value = "API応答の取得時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_httpget
iCol = iCol + 1
Cells(iCol, 1).Value = "API応答のJSONの解析時間"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_t_parse
iCol = iCol + 1
Cells(iCol, 1).Value = "HTTPのレスポンスステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objJpoApi.m_response.Status
iCol = iCol + 1
End If
If Not (objJpo Is Nothing) Then
If objJpo.Exists("result") Then
Dim objResult As Object
Set objResult = objJpo.Item("result")
If objResult.Exists("statusCode") Then
Cells(iCol, 1).Value = "ステータスコード"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("statusCode")
iCol = iCol + 1
End If
If objResult.Exists("errorMessage") Then
Cells(iCol, 1).Value = "エラーメッセージ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("errorMessage")
iCol = iCol + 1
End If
If objResult.Exists("remainAccessCount") Then
Cells(iCol, 1).Value = "残アクセス数"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Cells(iCol, 2).Value = objResult.Item("remainAccessCount")
iCol = iCol + 1
End If
If objResult.Item("statusCode") = "100" _
And objResult.Exists("data") Then
Cells(iCol, 1).Value = "詳細情報データ"
Cells(iCol, 1).Font.Color = RGB(128, 0, 0)
Dim objData As Object
Set objData = objResult.Item("data")
If objData.Exists("applicationNumber") Then
Cells(iCol, 2).Value = "出願番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("applicationNumber")
iCol = iCol + 1
End If
If objData.Exists("filingDate") Then
Cells(iCol, 2).Value = "出願日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("filingDate")
iCol = iCol + 1
End If
If objData.Exists("registrationNumber") Then
Cells(iCol, 2).Value = "登録番号"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationNumber")
iCol = iCol + 1
End If
If objData.Exists("registrationDate") Then
Cells(iCol, 2).Value = "登録日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("registrationDate")
iCol = iCol + 1
End If
If objData.Exists("decisionDate") Then
Cells(iCol, 2).Value = "査定日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("decisionDate")
iCol = iCol + 1
End If
If objData.Exists("appealTrialDecisiondDate") Then
Cells(iCol, 2).Value = "審決日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("appealTrialDecisiondDate")
iCol = iCol + 1
End If
If objData.Exists("rightPersonInformation") Then
Dim objRightPerson As Variant
For Each objRightPerson In objData.Item("rightPersonInformation")
If objRightPerson.Exists("rightPersonCd") Then
Cells(iCol, 3).Value = "権利者コード"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objRightPerson.Item("rightPersonCd")
iCol = iCol + 1
End If
If objRightPerson.Exists("rightPersonName") Then
Cells(iCol, 3).Value = "権利者"
Cells(iCol, 3).Font.Color = RGB(128, 0, 0)
Cells(iCol, 4).Value = objRightPerson.Item("rightPersonName")
iCol = iCol + 1
End If
Next
End If
If objData.Exists("inventionTitle") Then
Cells(iCol, 2).Value = "発明の名称"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("inventionTitle")
iCol = iCol + 1
End If
If objData.Exists("numberOfClaims") Then
Cells(iCol, 2).Value = "請求項の数"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("numberOfClaims")
iCol = iCol + 1
End If
If objData.Exists("expireDate") Then
Cells(iCol, 2).Value = "存続期間満了年月日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("expireDate")
iCol = iCol + 1
End If
If objData.Exists("nextPensionPaymentDate") Then
Cells(iCol, 2).Value = "次期年金納付期限"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("nextPensionPaymentDate")
iCol = iCol + 1
End If
If objData.Exists("lastPaymentYearly") Then
Cells(iCol, 2).Value = "最終納付年分"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("lastPaymentYearly")
iCol = iCol + 1
End If
If objData.Exists("erasureIdentifier") Then
Cells(iCol, 2).Value = "本権利抹消識別"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("erasureIdentifier")
iCol = iCol + 1
End If
If objData.Exists("disappearanceDate") Then
Cells(iCol, 2).Value = "本権利抹消日"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("disappearanceDate")
iCol = iCol + 1
End If
If objData.Exists("updateDate") Then
Cells(iCol, 2).Value = "更新日付"
Cells(iCol, 2).Font.Color = RGB(128, 0, 0)
Cells(iCol, 3).Value = objData.Item("updateDate")
iCol = iCol + 1
End If
End If
End If
End If
Set objJpoApi = Nothing
End Sub
GetRegistrationInfo(出願番号)は以下です。
'---------------------------------------------------------------------------
' 登録情報を取得 : registration_info
'
Public Function GetRegistrationInfo(requestNumber As String, Optional aVersion As String = "v1") As Object
Set GetRegistrationInfo = Nothing
m_t_httpget = 0
Select Case aVersion
Case "v1"
m_t_httpget = GetMicroSecond()
m_objHttp.m_authorization = m_access_token
Set m_response = m_objHttp.GetData(JPOAPI_V1_URL & "/registration_info/" & requestNumber)
m_t_httpget = GetMicroSecond() - m_t_httpget
Case Else
Set m_response = Nothing
Exit Function
End Select
m_t_parse = 0
If Not (m_response Is Nothing) Then
If 200 <= m_response.Status And m_response.Status < 300 Then
m_t_parse = GetMicroSecond()
Set GetRegistrationInfo = JsonConverter.ParseJson(m_response.responseText)
m_t_parse = GetMicroSecond() - m_t_parse
Call Application.Wait(Now + TimeValue("00:00:06"))
End If
End If
End Function
3 HttpClass
HttpClass は、サーバにHttpプロトコルでアクセスするための層であり、JpoApiClass から呼び出されます。
| 名称 | 概要 | 関数とその引数 |
|---|---|---|
| GETリクエスト | HTTPプロトコルのGET | GetData(url) |
| POSTリクエスト | HTTPプロトコルのPOST | PostData3(url,szKeyValues) |
3.1 GetData
Http Getリクエストを行います。
予めメンバー変数 m_authorization 変数に access_token を設定してください。
GetData(url)は以下です。
Public Function GetData(ByVal url As String) As Object
Dim objweb As Object
If False Then
myError:
iCreate = iCreate + 1
On Error GoTo 0
Err.Clear
Set objweb = Nothing
If iCreate >= 3 Then
Set GetData = Nothing
Exit Function
End If
End If
'XMLHTTPオブジェクトを生成
Set objweb = CreateHttpObject()
'オブジェクトの生成に失敗していれば処理終了
If objweb Is Nothing Then
Set GetData = Nothing
Exit Function
End If
On Error GoTo Error0
objweb.Open "GET", url, False
If Len(m_authorization) > 0 Then
Call objweb.setRequestHeader("Authorization", "Bearer " + m_authorization)
End If
objweb.Send
Set GetData = objweb
Set objweb = Nothing
On Error GoTo 0
Exit Function
Error0:
Resume myError
End Function
3.2 PostData3
Http Postリクエストを行います。
szKeyValues配列に、（キー）=（値）を設定して呼び出してください。
PostData3(url,szKeyValues)は以下です。
Public Function PostData3(ByVal url As String, ByRef szKeyValues() As String) As Object
Dim objweb As Object
If False Then
myError:
iCreate = iCreate + 1
On Error GoTo 0
Err.Clear
Set objweb = Nothing
If iCreate >= 3 Then
Set PostData3 = Nothing
Exit Function
End If
End If
'XMLHTTPオブジェクトを生成
Set objweb = CreateHttpObject()
'オブジェクトの生成に失敗していれば処理終了
If objweb Is Nothing Then
Set PostData3 = Nothing
Exit Function
End If
On Error GoTo Error0
Call objweb.Open("POST", url, False)
Call objweb.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Dim szBodyToSend As String
szBodyToSend = vbNullString
Dim i As Integer
For i = LBound(szKeyValues) To UBound(szKeyValues)
Dim KeyValue As Variant
Dim idx As Integer
idx = InStr(szKeyValues(i), "=")
If idx > 0 Then
If Len(szBodyToSend) <> 0 Then
szBodyToSend = szBodyToSend & "&"
End If
szBodyToSend = szBodyToSend & Mid(szKeyValues(i), 1, idx - 1)
szBodyToSend = szBodyToSend & "="
szBodyToSend = szBodyToSend & encodeUrlUtf8(Mid(szKeyValues(i), idx + 1))
End If
Next i
objweb.Send (szBodyToSend)
Set PostData3 = objweb
On Error GoTo 0
Exit Function
Error0:
Resume myError
End Function