【コード】Google PatentからPDFを取得する

—————————————————–
後日、修正版を公開いたしましたので、こちらもご覧ください。
【コード】Google PatentからPDFを取得する(その2)
—————————————————–

日英特許翻訳にて英語表現を探すときに、ネイティブが書いた関連分野の特許文献を読むことが有効であることがよくいわれています。

私も、新しい分野で訳語を知らない場合には、いくつかの特許明細書をざっと読んで表現・専門用語を探します。

対象となる文献を探すのは、USPTOのデータベースを使うのがいいでしょう。

以前、「USPTOの特許DBからネイティブの英語を探す方法 」の記事で探し方を紹介しました。

上記記事でも書いたのですが、適当な明細書が見つかったらPDFファイルで取得して図面と照らし合わせながらおいしい表現を見つけるのがいいかなと思っています。

そのときのPDFの取得に便利なのが今回のマクロです。

Google Patentを使って、米国特許明細書のPDFを取得します。

このマクロでできること

米国特許番号を入力すると、自動的にデスクトップにファイルがダウンロードされて保存されます。

Wordファイルに記載された特許番号を選択してマクロを実行すると、選択されている特許番号からコンマや国名コードのUSを削除して表示します。

半角でも大丈夫。

半角数字で入力

全角でも大丈夫。

全角数字で入力

OKをクリックすると、デスクトップ上に一瞬でファイルをダウンロードします。

デスクトップにダウンロード

マクロの解説

APIという仕組みを使っています。

これを使うことで、インターネット上に保存されているPDFファイルの取得を可能にしました。

今回のマクロでは、

1.対象のPDFファイルが掲載されているURLを取得

2.PDFファイルをダウンロードしてデスクトップに保存

を実行しています。

1.は、米国特許番号から規則的につくることができます。2.にAPIを用いています。

APIについては、Excel VBAの師匠である田中先生のサイトを参考にしました。

画像をダウンロードする

APIについての細かい解説は、上記サイトをご覧ください。

マクロは、Google_Patent_PDFを実行してください。Public Declare Function…ではありません。

マクロ


#If VBA7 And Win64 Then
 '64ビット版
 Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
  Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
  ByVal szURL As String, ByVal szFileName As String, _
  ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
 '32ビット版
 Public Declare Function URLDownloadToFile Lib "urlmon" _
  Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
  ByVal szURL As String, ByVal szFileName As String, _
  ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If

Sub Google_Patent_PDF()
 
 Dim myFilePath As String '保存先
 Dim myPatNum As String  '米国特許番号
 Dim myDestTopPath As String 'デスクトップのパス
 Dim myURL As String   'Google PatentのPDFファイルのURL
 Dim Ret As Long

 '特許番号のデフォルト値の取得(選択中の文字列です)
 If Selection.Start = Selection.End Then
  myPatNum = ""
 Else
  myPatNum = Selection.Text
 End If

 '表記統一(コンマとUSを削除)
 myPatNum = Replace(Expression:=myPatNum, Find:=",", Replace:="", Compare:=vbTextCompare)
 myPatNum = Replace(Expression:=myPatNum, Find:="US", Replace:="", Compare:=vbTextCompare)

 '米国特許番号の入力
 myPatNum = InputBox("番号を入力してください。(先頭のUSは不要)", "米国特許のPDFファイルの取得", myPatNum)
 If myPatNum = "" Then Exit Sub
 myPatNum = "US" & StrConv(myPatNum, vbNarrow)

 'URLと保存用のデスクトップのパスを作成
 myURL = "http://www.google.com/patents/" & myPatNum & ".pdf"
 myDestTopPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\"

 'ファイル名の設定
 myFilePath = myDestTopPath & myPatNum & ".pdf"
 
 'PDFファイルのダウンロードと保存実行(APIを利用)
 Ret = URLDownloadToFile(0, myURL, myFilePath, 0, 0)
 If Ret = 0 Then
   MsgBox "ダウンロードできました"
 Else
   MsgBox "ダウンロードできませんでした。"
 End If

End Sub

トップへ戻る