Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　ブックを開かずに条件に該当するデータの件数を調べる
'
'  Copyright(C) 2000 Sunago
'
'　　ブック(266data.xls)のSheet1にあるデータから列名がIDの列で
'  値が'005'以上の行を取得します。このマクロではFilterプロパティを
'  用いて最終レコードまで移動し、RecordCountプロパティの値より
'  データ件数を調べます。
'
'　　このマクロを実行するには、参照可能なライブラリファイルとして
'  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
Dim strerr As String
Dim lngcnt As Long

    'バージョンチェック
    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
    
    '該当する条件のデータ件数を調べる
    ' Filterプロパティを用いる例
    Rec.Open "[Sheet1$]", , adOpenStatic, , adCmdTable
    Rec.Filter = "ID >= '005'"
    Rec.MoveLast
    MsgBox "該当データは " & Rec.RecordCount & "件あります"
    ' SQL文のCount関数を用いる例
    'Rec.Open "SELECT Count(*) FROM [Sheet1$] WHERE ID >= '005'", , , , adCmdText
    'MsgBox "該当データは " & Rec(0) & "件あります"

    Rec.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