指定した条件で抽出した結果を1件ずつ読み込む

Option Explicit

Private Sub ExAccdbSelectImport()
    Dim db As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim cmd As ADODB.Command
    Dim SQL As String
    Dim lrow As Long
    
    '苗字が「山本」を抽出
    SQL = "SELECT *FROM T_顧客マスター2000件 WHERE 顧客名 LIKE '山本%'"
        
    '顧客管理のACCDBファイルに接続します
    Set db = New ADODB.Connection
    db.Provider = "Microsoft.Ace.OLEDB.12.0"
    db.Open "C:\MyHP\excel2007\Tips\顧客管理.accdb"

    'レコードセットを開きます
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = db
    'SQLをセット
    cmd.CommandText = SQL
    Set rs = cmd.Execute
    
    If rs.EOF Then
        MsgBox "抽出した結果、顧客のレコードが見つかりません。"
    Else
        '読込みを開始する行位置
        lrow = 7
        '最終レコードまで
        While Not rs.EOF
            Cells(lrow, 2) = rs("顧客ID")
            Cells(lrow, 3) = rs("顧客名")
            Cells(lrow, 4) = rs("TEL")
            Cells(lrow, 5) = rs("FAX")
            Cells(lrow, 6) = rs("郵便番号")
            Cells(lrow, 7) = rs("住所")
            Cells(lrow, 8) = rs("メモ")
            '次の行
            lrow = lrow + 1
            '次のレコード
            rs.MoveNext
        Wend
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
End Sub

Private Sub CommandButton1_Click()
    ExAccdbSelectImport
End Sub