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

Sub ImportExcelData()

    'Accessオブジェクトを作成
    Dim acApp As Object
    Set acApp = CreateObject("Access.Application")
    
    'Accessデータベースを開く
    acApp.OpenCurrentDatabase Application.CurrentProject.FullName
    
    'Accessの社員一覧テーブルを開く
    Dim acTable As Object
    Set acTable = acApp.CurrentDb.OpenRecordset("社員一覧")

    'ワークブックオブジェクト変数の定義
    Dim wb As Workbook 
    '読込み先ファイルのパスを格納する変数を定義
    Dim fn As String
    
    '読み込み先Excelファイルを選択するためのダイアログを表示させます。
    Dim dlg As FileDialog
    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    dlg.Filters.Clear
    dlg.Filters.Add "Excel ファイル", "*.xlsx"
    dlg.Title = "検索先Excel ファイルを選択して下さい。"
    If dlg.Show = -1 Then
      fn = dlg.SelectedItems(1)
    End If
    
    ' ファイル選択でキャンセルを選択した場合の処理
    If fn = "" Then
       MsgBox "キャンセルしました。"
       Exit Sub
    End If

    '参照先Excelファイルをwb変数に設定します。
    Set wb = Workbooks.Open(FileName:=fn, UpdateLinks:=0)
    '（UpdateLinks:=0 にすると、リンクを更新せずに開きます。）
    
    '参照先Excelファイルのシート名（Sheet1）をws変数に設定
    Dim ws As Worksheet
    Set ws = wb.Sheets("Sheet1")
    
    'カウント変数の定義
    Dim i As Long
    'テーブルのレコード数分をループ
    For i = 1 To acTable.recordCount
    
        'レコードから検索キーを取得
        Dim searchValue As String
        searchValue = acTable("社員No").Value
        
        'Excelから該当する行のデータを検索
        Dim foundRow As Range
        Set foundRow = ws.Range("A:A").Find(searchValue) ' 検索範囲や条件に応じて変更
        
        '検索の結果Excel上に該当するデータが見つかったらデータを取得してAccessのテーブルに書き込む
        If Not foundRow Is Nothing Then
        
            'Excel上の該当するデータを取得
            Dim rowData As Variant
            rowData = foundRow.EntireRow.Value
                        
            'Excelの5列目のデータをAccessの"勤務地フィールド"に書き込む
            acTable.Edit
            acTable("勤務地").Value = rowData(1, 5)
            
            '社員一覧テーブルを更新
            acTable.Update
        End If
        
        '次のレコードに移動
        acTable.MoveNext
          
        'ステータスバーに処理件数を表示
        SysCmd acSysCmdSetStatus, "処理件数： " & i - 1
        
    Next i
    
    '社員一覧テーブルを閉じて、オブジェクトをクリアする
    acTable.Close
    Set acTable = Nothing
        
    '参照先のExcelを保存せずに閉じる
    wb.Close saveChanges:=False
    
    'ステータスバーをクリアする
    SysCmd acSysCmdClearStatus
        
    '完了メッセージを表示する
    MsgBox "処理が完了しました。" & vbCrLf & "処理件数は" & i - 1 & "件です。", vbOKOnly + vbInformation, "処理完了"
    
End Sub