ACCESS VBAにおけるExcelセル範囲の取得について

Question

実現したいこと

・Access VBAからExcelファイルを開き、所定のセル範囲のうち空白行を除いたセル範囲を二次元配列で取得

前提

・Accessにマクロを組み込みたいので、Excel VBAは使用したくない

発生している問題・エラーメッセージ

・Excel VBAでセル範囲から空白行を除き、セル範囲を二次元配列として取得する際は
SelectionやCurrentRegionを使っていたが、Access VBAでは使えなさそうなので、Access VBAの場合はどのような手段があるのかを知りたい

該当のソースコード

Option Compare Database
Option Explicit

Dim Con As Object
Dim FolderPath As String
Dim ExcelApp As Object
Dim FilePath As String
Dim ExcelWorkbook As Object
Dim ExcelWorksheet As Object
Dim CellsRange As Variant
Dim RecordExist As Boolean
Dim ShipmentDate As Date

Dim i As Long

Sub ImportDataFromExcel()

FolderPath = Application.CurrentProject.Path & ""

Set ExcelApp = CreateObject("Excel.Application")

FilePath = Dir(FolderPath & "*.xls")

Do While FilePath <> ""

Set ExcelWorkbook = ExcelApp.workbooks.Open(FolderPath & FilePath, , True)

Set ExcelWorksheet = ExcelWorkbook.Sheets("List")

ShipmentDate = ExcelWorksheet.range("G4").Value
CellsRange = ExcelWorksheet.range("B9:G32")

Dim db As DAO.Database
Set db = CurrentDb()

Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT * FROM A_TBL")

RecordExist = False

For i = LBound(CellsRange, 1) To UBound(CellsRange, 1)

Do Until rs.EOF

If rs.Fields("ID").Value = CellsRange(i, 5) Then

RecordExist = True

Exit Do

End If

rs.MoveNext

Loop

If Not RecordExist Then

rs.AddNew

rs.Fields("PART_NUMBER").Value = CellsRange(i, 2)
rs.Fields("ID").Value = CellsRange(i, 5)
rs.Fields("DELIVERY_DATE").Value = ShipmentDate

rs.Update

End If

Next

rs.Close

Set rs = Nothing

db.Close

Set db = Nothing

ExcelWorkbook.Close False

FilePath = Dir()

Loop

MsgBox "処理が完了しました"

ExcelApp.Quit

Set ExcelApp = Nothing

End Sub

### 試したこと

Excel VBAと同じコードが使えるが試してみたが駄目だった。

### 補足情報（FW/ツールのバージョンなど）

ご指導ご鞭撻宜しくお願いいたします。

Comments

[hatena19]

現状のAccessのコードを提示してください。

ExcelオブジェクトをCreateObjectかNewで生成してますか。
生成してればそれを通じてExcelのメソッド、プロパティは普通に使えます。

[Crucian_carp]

コメントありがとうございます。現在のコードを貼ります。

Option Compare Database
Option Explicit

Dim Con As Object
Dim FolderPath As String
Dim ExcelApp As Object
Dim FilePath As String
Dim ExcelWorkbook As Object
Dim ExcelWorksheet As Object
Dim CellsRange As Variant
Dim RecordExist As Boolean
Dim ShipmentDate As Date

Dim i As Long

Sub ImportDataFromExcel()

FolderPath = Application.CurrentProject.Path & "\"

Set ExcelApp = CreateObject("Excel.Application")

FilePath = Dir(FolderPath & "*.xls")

Do While FilePath <> ""

Set ExcelWorkbook = ExcelApp.workbooks.Open(FolderPath & FilePath, , True)

Set ExcelWorksheet = ExcelWorkbook.Sheets("Wafer List")

ShipmentDate = ExcelWorksheet.range("G4").Value
CellsRange = ExcelWorksheet.range("B9:G32")

Dim db As DAO.Database
Set db = CurrentDb()

Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT * FROM A_TBL")

RecordExist = False

For i = LBound(CellsRange, 1) To UBound(CellsRange, 1)

Do Until rs.EOF

If rs.Fields("ID").Value = CellsRange(i, 5) Then

RecordExist = True

Exit Do

End If

rs.MoveNext

Loop

If Not RecordExist Then

rs.AddNew

rs.Fields("PART_NUMBER").Value = CellsRange(i, 2)
rs.Fields("ID").Value = CellsRange(i, 5)
rs.Fields("DELIVERY_DATE").Value = ShipmentDate

rs.Update

End If

Next

rs.Close

Set rs = Nothing

db.Close

Set db = Nothing

ExcelWorkbook.Close False

FilePath = Dir()

Loop

MsgBox "処理が完了しました"

ExcelApp.Quit

Set ExcelApp = Nothing

End Sub

[hatena19]

質問は編集できますので、質問の方にコードを追記してください。
ここは開かないと見えないので回答がつきにくいです。

[Crucian_carp]

ありがとうございます。質問の方にソースコードを記入しました。

[hatena19]

追記されたコードに、SelectionやCurrentRegionはないので、
追記されたときに削除されたExcelのコードをAccessに書き換える回答をしましたので、
参考にしてください。

Answer 1

・Excel VBAでセル範囲から空白行を除き、セル範囲を二次元配列として取得する際は
SelectionやCurrentRegionを使っていたが、Access VBAでは使えなさそうなので、Access VBAの場合はどのような手段があるのかを知りたい

Access VBAからでも Selection, CurrentRegion は普通に使えます。
ただし、Excelでは親オブジェクトを省略できますが、Accessではきっちり指定する必要があります。

Range(CellAddress_).CurrentRegion.Select
    Selection.Offset(OffsetNumber_, 0).Resize(Selection.Rows.Count - ResizeNumber_).Select

これをAccess VBAで記述するなら、下記のようになります。(ExcelWorksheet, ExcelAppの生成部分は省略してます。)

ExcelWorksheet.Range(CellAddress_).CurrentRegion.Select
ExcelApp.Selection.Offset(OffsetNumber_, 0).Resize(ExcelApp.Selection.Rows.Count - ResizeNumber_).Select

ただし、Select や Selection を使わなくても同様の処理ができます。そのほうがトラブルやバグが発生しにくいので推奨します。

例えば、上記のコードなら、

Dim ExcelRange As Object
Set ExcelRange = ExcelWorksheet.Range(CellAddress_).CurrentRegion
Set ExcelRange = ExcelRange.Offset(OffsetNumber_, 0).Resize(ExcelRange.Rows.Count - ResizeNumber_)

としておいてExcelRangeに対してご希望の処理をおこなえばいいでしょう。

Comments

[Crucian_carp]

ご丁寧に教えていただき誠にありがとうございます！大変勉強になりました。