Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　ブックを開かずにデータを更新する
'
'  Copyright(C) 2000 Sunago
'
'　　ブック(266data.xls)のSheet1にあるデータから列名がIDの列で
'  値が'005'以上の行を取得します。このマクロではＳＱＬ文を
'  使わずにFilterプロパティを使って絞り込みを行います。
'
'　　このマクロを実行するには、参照可能なライブラリファイルとして
'  Microsoft ActiveX Data Objects 2.1 Library(ADO)または同等
'  ライブラリへの参照設定が必要です。
'
Option Explicit

Sub Macro1()
Dim Cnn As ADODB.Connection
Dim Rec As ADODB.Recordset
Dim strSQL As String

    'バージョンチェック
    If Ver9Check = False Then
        MsgBox "このバージョンのEXCELでは別途ADOライブラリを入手し、" & vbCr & _
                "インストールする必要があります。"
        Exit Sub
    End If
    
    Set Cnn = New ADODB.Connection
    Cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
    'Excel97,2000のブックはExcel8.0で設定する
    Cnn.Properties("Extended Properties") = "Excel 8.0"
    Cnn.Open Path(ThisWorkbook.Path) & "266data.xls"
    
    Set Rec = New ADODB.Recordset
    Set Rec.ActiveConnection = Cnn
    'ワークシートSheet1を更新可能な状態でオープンする
    Rec.Open "[Sheet1$]", , adOpenKeyset, adLockPessimistic, adCmdTable
    
    '条件の絞り込みを行う
    Rec.Filter = "ID >= '005'"
    '絞り込んだデータを１件ずつ更新する
    Do Until Rec.EOF
        Rec![備考] = "*"
        Rec.Update
        Rec.MoveNext
    Loop
    
    Rec.Close
    Cnn.Close
    Set Rec = Nothing
    Set Cnn = Nothing

End Sub

'/* データを取得する例 */
Sub Macro1_Select()
Dim Cnn As ADODB.Connection
Dim Rec As ADODB.Recordset

    'バージョンチェック
    If Ver9Check = False Then
        MsgBox "このバージョンのEXCELでは別途ADOライブラリを入手し、" & vbCr & _
                "インストールする必要があります。"
        Exit Sub
    End If
    
    Set Cnn = New ADODB.Connection
    Cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
    'Excel97,2000のブックはExcel8.0で設定する
    Cnn.Properties("Extended Properties") = "Excel 8.0"
    Cnn.Open Path(ThisWorkbook.Path) & "266data.xls"
    
    Set Rec = New ADODB.Recordset
    Set Rec.ActiveConnection = Cnn
    
    '該当する条件のデータを取得する
    Rec.Open "[Sheet1$]", , adOpenKeyset, adLockPessimistic, adCmdTable
    
    '抽出した内容を貼り付ける
    Worksheets("Sheet1").Range("A2").CopyFromRecordset Rec
    
    Rec.Close
    Cnn.Close
    Set Rec = Nothing
    Set Cnn = Nothing

End Sub

'/* パスの終わりを\にする関数 */
Function Path(arg1) As String
    
    If Right(arg1, 1) = "\" Then
        Path = arg1
    Else
        Path = arg1 & "\"
    End If
End Function

Private Function Ver9Check() As Boolean
Dim strver As String
    
    strver = Application.Version
    If Int(Left(strver, InStr(strver, "."))) < 9 Then
        Ver9Check = False
    Else
        Ver9Check = True
    End If

End Function