エクセルのデータからAccessにデータをインポート

Sub ImportFromAlreadyOpenWorkbook()
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object
    Dim rs As DAO.Recordset
    Dim i As Integer
    Dim j As Integer

    ' 既に開いているExcelのインスタンスを取得
    Set xlApp = GetObject(, "Excel.Application")
    
    ' 開いているワークブックを取得（例: 1番目の開いているワークブック）
    Set xlWorkbook = xlApp.Workbooks(1)
    
    ' 1番目のシートを使用
    Set xlWorksheet = xlWorkbook.Sheets(1)

    ' Accessテーブルを開く
    Set rs = CurrentDb.OpenRecordset("更新用テーブル")

    ' Excelデータをテーブルにインポート
    For i = 2 To xlWorksheet.UsedRange.Rows.Count ' 2行目から最終行まで（1行目はヘッダーと仮定）
        rs.AddNew
        For j = 1 To xlWorksheet.UsedRange.Columns.Count
            rs.Fields(j - 1).Value = xlWorksheet.Cells(i, j).Value
        Next j
        rs.Update
    Next i

    ' クリーンアップ
    rs.Close
    Set rs = Nothing
    Set xlWorksheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
End Sub