[ExcelVBA]弁護士名から弁護士情報を取得する

はじめに

• **弁護士名のリストから，事務所名や電話番号をまとめて検索したい！**というニッチなニーズにお応えするものです。
• 情報は，日弁連の弁護士情報検索(https://www.nichibenren.jp/member_general/lawyerandcorpsearchselect/lawyerInfoSearchInput/) から引っ張ってきます。
• 諸般の事情によりExcelしか使えない環境の方向けです。
• そうでなければ，「弁護士会員番号から，当該弁護士の情報を取得する（WebAPI版）」(https://qiita.com/kasanma3104/items/a0b9479f06fdd7ffee5c )をご参照いただいた方がよいです。

使い方

1. 「[VBA]30分あればできるVBAスクレイピング」（https://qiita.com/SoreKiita/items/4b4c845b7378f6765704 ）をよく読む。
2. エクセルに次のような表を作る。
   
3. B,C列に氏，名を必要なだけ入力する（補足も参照）。
4. VBEに下記コードをコピペ，実行。
5. 検索開始行を聞かれるので，任意の行を入力，Enter。

• Functionは下記をお借りしています。
  • WaitResponse：前掲「[VBA]30分あればできるVBAスクレイピング」
  • tagCheck：VBAで指定した要素が存在するかチェックするサブルーチン（https://www.vba-ie.net/element/tagcheck.php ）

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub NichibenrenSearch()
    On Error GoTo continue
    '行を数える
    Dim dataCnt As Long 'データ数
    dataCnt = Cells(Rows.Count, 2).End(xlUp).Row
    
    Dim target As Long '検索対象の行
    Dim startNum As Long '開始行
    startNum = InputBox("開始行は？")
    For target = startNum To dataCnt '開始行～データ数

        '起動
        Dim objIE As InternetExplorer
        Set objIE = New InternetExplorer
        
        objIE.Visible = True
        objIE.navigate "https://www.nichibenren.jp/member_general/lawyerandcorpsearchselect/lawyerInfoSearchInput/"
        
        Call WaitResponse(objIE)
        
        '検索
        Dim htmlDoc As HTMLDocument
        Set htmlDoc = objIE.document
        
        Dim targetLast As String
        Dim targetFirst As String
        
        targetLast = Cells(target, 2).Value
        targetFirst = Cells(target, 3).Value
        
        With htmlDoc
            .getElementById("last_name").Value = targetLast
            .getElementById("first_name").Value = targetFirst
            .getElementById("doLawyerInfoSearch").Click
        End With
        
        Call WaitResponse(objIE)
        
        '検索結果が0なら終了
        If tagCheck(objIE, "class", "text-right", "0") = True Then
            Cells(target, 6) = "◆該当なし"
            GoTo continue
        End If
        
        '検索結果一覧の一番上へ遷移
        'tableの2行目（tr(1)），2列目（td(1)），子（a）を取得。tdだけだとなぜかthもカウントされてうまくいかない
        htmlDoc.getElementsByTagName("tr")(1).getElementsByTagName("td")(1).Children(0).Click
    
        Call WaitResponse(objIE)
        
        '詳細情報取得
        '上の表
        Dim table1 As Object
        Set table1 = htmlDoc.getElementsByTagName("table")(0)
    
        Dim x As Long '上の表の列
        For x = 0 To 4 '5列分
            Cells(target, x + 5) = table1.Rows(1).Cells(x).innerText '行（rows）は2行目で固定，列（cells）は変動
        Next
        
        '下の表
        Dim table2 As Object
        Set table2 = htmlDoc.getElementsByTagName("table")(1)
           
        Dim y As Long '下の表の行
        For y = 0 To 7 '8行分
            Cells(target, y + 10) = table2.Rows(y).Cells(1).innerText '行（rows）は変動，列（cells）は2行目で固定
        Next
        
continue:
        objIE.Quit
    Next
    Beep
    MsgBox "完了"
End Sub

Sub WaitResponse(objIE As Object)
    Dim i As Long
    For i = 0 To 10
        Do While objIE.Busy = True Or objIE.readyState <> READYSTATE_COMPLETE '読み込み待ち
            DoEvents
        Loop
        Sleep 100 '追加で待ってあげないとうまくいかない
    Next
End Sub

Function tagCheck(objIE As InternetExplorer, _
                 methodType As String, _
                 elementName As String, _
                 keywords As String) As Boolean
  Dim objDoc  As Object, myDoc  As Object
  tagCheck = False
  Select Case methodType
    Case "name"
      Set objDoc = objIE.document.getElementsByName(elementName)
    Case "class"
      Set objDoc = objIE.document.getElementsByClassName(elementName)
    Case "tag"
      Set objDoc = objIE.document.getElementsByTagName(elementName)
  End Select
  For Each myDoc In objDoc
    If InStr(myDoc.outerHTML, keywords) > 0 Then
      tagCheck = True
      Exit For
    End If
  Next
End Function

補足

• 上のExcelシートには，B・C列にそれぞれ次の式を入れてあります。

=LEFT([@氏名],[@氏字数／修正])
=RIGHT([@氏名],LEN([@氏名])-[@氏字数／修正])

• これにより，A列に氏名を入れ，D列に氏の文字数を入れれば，B・C列に氏・名がうまいこと表示されます。
  • 例：「日弁太郎」なら「2」で，「日弁」と「太郎」に。
• マクロを実行すると…
  • 「弁護士情報検索」の漢字氏・名欄に，B・C列の氏・名を入れて検索。
  • 「検索結果一覧」の一番上の会員を選択。検索結果が0件なら諦めて次へ。
  • 「会員詳細情報」の上の方にある表の情報をE～I列に転記，下の方にある表の情報をJ～Q列に転記。なぜ2つに分けた。しかも行と列がばらっばらやないか
• 日弁連のサイトは，重いのでその特性上，WaitResponseでREADYSTATE_COMPLETEから100ms待ち，これを10回問い合わせ，かつOn Error continueしても，それでもたまに読み込み不良でエラーを吐く。根気よく実行しよう。

更新の余地

• 検索結果が「0」なら終了としてるけど，これ，「0」が含まれてる「10」「20」でも終了しますね…
• 検索方法が完全一致でなく部分一致で，しかも登録番号順に表示されるので，「日弁太郎」で検索しても，「日弁一太郎」の方が登録番号が若い場合，一太郎さんを取得してしまう…
• たぶん，検索結果一覧をTableで取得して，しかるべく処理すればよいのだけれども，レアケースだと思うので，Excelシートに確認のための列を作ってなんとかしてしまった。下記参照。「崎」／「﨑」など異字体チェックも兼ねて。

=IF(AND([@氏名2]<>"",[@氏名2]<>[@氏]&" "&[@名],[@済]=""),"◆要確認","")

• 諸々，動けばよかろうなのだの精神。