以前、Google Patentを用いて米国特許のＰＤＦファイルを自動でダウンロードする仕組みをご紹介しました。
【Wordマクロ】Google PatentからPDFを取得する
案外知られていませんが（笑）、けっこう便利です。セミナーで特許翻訳者の方々に紹介するとかなりの確率で喜んでいただけます。
先日のセミナーでもこのマクロをご紹介したのですが、使い方によってはエラーとなることがわかりまして、少し改造しました。
同じマクロでは面白くないので、今度は米国特許に限らず、欧州特許や国際特許（PCT出願）も対象としました。ただし、欧州特許や国際特許の場合にはファイルのダウンロードではなく、検索結果ページ（ファイルのダウンロードボタンが掲載されていることもあります）を表示します。
▼このマクロでできること
インプットボックスに特許番号を入力すると、自動的にデスクトップにファイルがダウンロードされて保存されます。
なお、Wordファイルに記載された特許番号を選択した状態でマクロを実行すると、インプットボックスに特許番号を表示します。
▼マクロの解説
以前のマクロでは、Wordファイルで特許番号を選択した場合、改行記号などの編集記号が選択範囲の末尾に含まれるとダウンロードがうまくいかない場合がありました。
そこで、選択範囲の末尾に特定の編集記号が含まれている場合には、それらを除外するようにしました。（赤文字部分）
デスクトップのパスの取得方法は、青文字で書いた通りです。
ネットのPDFファイルの取得方法については、以前の記事
をご覧ください。Excel VBAの田中先生の記事（画像をダウンロードする
）を参考にしました。
▼マクロ
新しい「標準モジュール」を挿入し、そのモジュールの先頭に記載してください。
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
Sub Google_Patent_PDF_2()
Dim myFilePath As String '保存先
Dim myPatNum As String '米国特許番号
Dim myDestTopPath As String 'デスクトップのパス
Dim myURL As String 'Google PatentのPDFファイルのURL
Dim Ret As Long
Selection.MoveEndWhile _
Cset:=Chr(9) & Chr(11) & Chr(12) & Chr(13) & Chr(14), _
Count:=wdBackward
'特許番号のデフォルト値の取得（選択中の文字列です）
If Selection.Start = Selection.End Then
myPatNum = ""
Else
myPatNum = Selection.Text
End If
'特許番号の入力
myPatNum = InputBox("番号を入力してください。", "特許のPDFファイルの取得", myPatNum)
If myPatNum = "" Then Exit Sub
'コンマを削除
myPatNum = Replace(myPatNum, ",", "", Compare:=vbTextCompare)
'半角化
myPatNum = 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
On Error Resume Next
myURL = "https://www.google.com/patents/" & myPatNum & "?hl=ja&cl=en"
ActiveDocument.FollowHyperlink Address:=myURL
If Err <> 0 Then
MsgBox "検索できませんでした。"
Else
MsgBox "検索結果を表示しました。"
End If
On Error GoTo 0
End If
End Sub
▼お知らせ
なんと、Office TANAKAの田中先生
が、５月１５日（木）に翻訳者向けにＪＴＦで講演されます！
行くしかないでしょ？
翻訳業務でExcelを効率よく使うには
▼関連記事
【Wordマクロ】Google PatentからPDFを取得する
画像をダウンロードする
（Office TANAKAの記事）
エスパスネットを利用する
USPTOの特許DBからネイティブの英語を探す方法
↧
【Wordマクロ】Google PatentからPDFを取得する（その２）
↧