複数Accessファイル検索

コード

Sub ファイル分割メイン()
Sub メイン()

'CreateObjectを使用する場合
'Dim DAO As Object
'Set DAO = CreateObject("DAO.DBEngine.120") 'accdbファイルの場合
    'or
'Set DAO = CreateObject("DAO.DBEngine.36")  'mbdファイルの場合

Dim ws As DAO.Workspace 'ワークスペース
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim i As Long
Dim vSQL As String
Dim accessFile As String
Dim word As String

Dim lastRow As Long

Dim tgtFolder As String
tgtFolder = Range("F2").Value

'繰り返しファイルの範囲取得
Dim rngList As Range
If Range("F5").Value <> "" Then
    Set rngList = Range(Range("F5"), Cells(Rows().Count, 6).End(xlUp))
    Debug.Print rngList.Address
    Stop
    Set rngList = Union(rngList.SpecialCells(xlCellTypeConstants), rngList.SpecialCells(xlCellTypeFormulas))
    Debug.Print rngList.Address
    Stop
Else
    MsgBox "ファイルが１つも設定されていません", vbCritical
    Exit Sub
End If

'検索ワード設定
word = Sheets(sheetMENU).Range("F2").Value


'メイン処理
For Each myRng In rngList
    If myRng.Value = "" Then Exit For
    
    Set ws = DAO.DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase(myRng)
    
    vSQL = "SELECT * FROM テーブル名 WHERE 都道府県 LIKE '*" & word & "*' OR 氏名 LIKE '*" & word & "*'"
    Set rs = db.OpenRecordset(vSQL, dbOpenDynaset)
    
    'フィールド名取得
    For i = 0 To rs.Fields.Count - 1
        Debug.Print rs.Fields(i).Name
    Next
    
    '出力シートに張り付け
    lastRow = 書き込み行取得(sheetOUT)
    Sheets(sheetOUT).Cells(lastRow, 1).CopyFromRecordset rs
    
    rs.Close
    db.Close
    ws.Close
Next myRng

End Sub

解説