[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. エクセルに次のような表を作る。
![nichibenren.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/631578/bd3e1dd3-7403-3c40-1688-335f318f90b1.png)
3. B,C列に氏，名を必要なだけ入力する（補足も参照）。
4. VBEに下記コードをコピペ，実行。
5. 検索開始行を聞かれるので，任意の行を入力，Enter。

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

```vb
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]<>[@氏]&" "&[@名],[@済]=""),"◆要確認","")
```
- 諸々，動けばよかろうなのだの精神。