【Word VBA】Google PatentからPDFを取得する

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

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

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

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

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

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

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

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

このマクロでできること

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

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

半角でも大丈夫。

全角でも大丈夫。

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

マクロの解説

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

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

今回のマクロでは、

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

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

を実行しています。

1．は、米国特許番号から規則的につくることができます。2．に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

• 2. Re:こんにちは

  ＞年商５兆円企業からの脱サラ　北村　勇二さん

  コメントをどうもありがとうございます。

  Wordマクロでお役に立てそうなところがあれば、ご連絡ください。

  アイディア練りましょう。

  新田順也☆ワードプログラマー2012-11-21 09:10:32返信する

• 1. こんにちは

  ブログ拝見しました記事を読んだのでコメントさせていただきました。僕は人生どん底から這い上がる軌跡をブログで書き記しています。ご興味があれば訪問頂ければ幸いです。

  年商５兆円企業からの脱サラ　北村　勇二2012-11-19 10:45:23