-----------------------------------------------------
後日、修正版を公開いたしましたので、こちらもご覧ください。
【コード】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
コメント