Accessのテーブルを検索しその結果に基づいてExcelのデータを更新する

Option Explicit

Sub UpdateExcelDataFromAccess()
    
    ' 参照先ファイルのパスを格納する変数を定義
    Dim fn As String
    ' 参照先ACCESSファイルをダイアログから選択して、選択したファイルパスを格納する。
    fn = Application.GetOpenFilename(("ACCESSファイル (*.accdb), *.accdb"), , "ブックを選択して下さい。")

    If fn = "False" Then
      MsgBox "キャンセルしました。"
      Exit Sub
    End If
    
    ' Accessデータベースへの接続
    Dim conn As Object
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fn & " ;Persist Security Info=False;"
    
    ' 更新対象のテーブルとExcelデータの範囲を指定
    Dim tblName As String
    Dim keyColName As String
    Dim keyColIndex As Integer
    Dim excelDataRange As Range
    tblName = "社員一覧"
    keyColName = "社員No"
    Set excelDataRange = Range(Cells(1, 1), Cells(16, 6))
    
    ' 検索キーとなる「社員No」の列番号を取得
    keyColIndex = CInt(Application.Match(keyColName, excelDataRange.Rows(1), 0))
    
    ' Excelデータのレコードを1件ずつ処理
    Dim i As Integer
    For i = 2 To excelDataRange.Rows.Count
        ' キー列の値を取得
        Dim keyValue As Variant
        keyValue = excelDataRange.Cells(i, keyColIndex).Value
        
        ' 更新対象のレコードを取得
        Dim sql As String
        sql = "SELECT * FROM " & tblName & " WHERE " & keyColName & " = """ & keyValue & """;"
        Dim rs As Object
        Set rs = conn.Execute(sql)
        
        ' レコードが存在する場合はExcelデータを更新する
        If Not rs.EOF Then
            excelDataRange.Cells(i, 5).Value = rs.Fields("勤務地").Value
        End If
        
        rs.Close
    Next i
    
    ' Accessデータベースへの接続を切断
    conn.Close
    
    ' 完了メッセージを表示する
    MsgBox "更新が完了しました。"
    
End Sub