1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

JpoApiClass:特許情報取得API用VBAクラス

Last updated at Posted at 2022-01-29

#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 に続くパス名であり、'/'から始まる文字列です。

トークン取得.PNG

GetToken(id,password) を呼び出すテストコードは以下です。

GetTokenの戻り値は、JpoApiClass(Object型)です。

get_token
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)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' トークンを取得
'
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) を呼び出すテストコードは以下です。
get_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)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' トークンを更新
'
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桁の半角数字です。

特許経過情報取得.PNG

GetAppProgress(出願番号) を呼び出すテストコードは以下です。
app_progress
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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 特許経過情報を取得 : 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桁の半角数字です。

シンプル版特許経過情報取得.PNG

GetAppProgressSimple(出願番号) を呼び出すテストコードは以下です。
app_progress_simple
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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' シンプル版特許経過情報を取得 : 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桁の半角数字です。

特許分割出願情報取得.PNG

GetDivisionalAppInfo(出願番号) を呼び出すテストコードは以下です。
divisional_app_info
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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 特許分割出願情報を取得 : 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桁の半角数字です。

特許優先基礎出願情報取得.PNG

GetPriorityRightAppInfo(出願番号) を呼び出すテストコードは以下です。
priority_right_app_info
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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 特許優先基礎出願情報を取得 : 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桁の半角数字です。

特許申請人氏名・名称取得.PNG

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(申請人コード)は以下です。
JpoApiClass
'------------------------------------------------------------------------
' 特許申請人氏名・名称を取得 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桁の半角数字です。

特許申請人コード取得.PNG

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(申請人名称)は以下です。
JpoApiClass
'------------------------------------------------------------------------
' 特許申請人コードを取得 : 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セルに登録番号を設定してください。

特許番号参照.PNG

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(種類,番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 特許番号参照: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ファイルが解凍されます。

特許申請書類取得.PNG

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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 特許申請書類(実体ファイル)を取得 : 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ファイルが解凍されます。

特許発送書類取得.PNG

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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 特許発送書類(実体ファイル)を取得 : 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ファイルが解凍されます。

拒絶理由通知書取得.PNG

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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 拒絶理由通知書(実体)を取得 : 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桁の半角数字です。

特許引用文献情報取得.PNG

GetCiteDocInfo(出願番号) を呼び出すテストコードは以下です。
cited_doc_info
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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 特許引用文献情報を取得 : 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桁の半角数字です。

登録情報取得.PNG

GetRegistrationInfo(出願番号) を呼び出すテストコードは以下です。
registration_info
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(出願番号)は以下です。
JpoApiClass
'---------------------------------------------------------------------------
' 登録情報を取得 : 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)は以下です。
HttpClass
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)は以下です。
HttpClass
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
1
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?