Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　テキストファイルから特定のデータを取り込む
'
'  Copyright(C) 2000 Sunago
'
'　　このマクロを動作させるには、読み込むＣＳＶファイルの
'　レイアウトにあわせてmakeSchemaIniで作成するSchema.iniの
'　定義を修正する必要があります。
'
'　※このサンプルを実行するには、参照可能なライブラリファイルとして
'　　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 strPath As String
Const filename = "270data.txt"
Dim ret

    'バージョンチェック
    If Ver9Check = False Then
        MsgBox "このバージョンのEXCELでは別途ADOライブラリを入手し、" & vbCr & _
                "インストールする必要があります。"
        Exit Sub
    End If

    strPath = Path(ThisWorkbook.Path)
    'Schema.iniが見つからないときは作成する。
    ret = Dir(strPath & "Schema.ini")
    If ret = "" Then
        Call makeSchemaIni(strPath, filename)
    End If
    Set Cnn = New ADODB.Connection
    Cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
    Cnn.Properties("Extended Properties") = "Text"
    Cnn.Open strPath
    
    Set Rec = New ADODB.Recordset
    Set Rec.ActiveConnection = Cnn
    Rec.Open filename, , adOpenStatic, , adCmdTable
    
    '条件の絞り込みを行う
    Rec.Filter = "住所 = '北海道'"
    'アクティブセルに抽出した内容を貼り付ける
    Worksheets("Sheet1").Range("A2").CopyFromRecordset Rec
    
    Rec.Close
    Cnn.Close
    Set Rec = Nothing
    Set Cnn = Nothing

End Sub

' TextISAM情報を作成する
'
Sub makeSchemaIni(sPath, sFile)
Dim Msg As String
Dim Handle As Integer
Dim fldName As String, fldDataInfo As String

    Handle = FreeFile
    If Right(sPath, 1) = "\" Then
        Open sPath & "schema.ini" For Output As #Handle
    Else
        Open sPath & "\schema.ini" For Output As #Handle
    End If
    
    'ヘッダー情報の作成
    Print #Handle, "[" & sFile & "]"
    ' 先頭行を見出しとするか(True/False)
    Print #Handle, "ColNameHeader=False"
    ' ファイルの種類(CSVDelimited/TabDelimited/Delimited(*)/FixedLength)
    Print #Handle, "Format=CSVDelimited"
    ' 文字コード(通常はOEM or ANSI)
    Print #Handle, "CharacterSet=OEM"
    ' 列情報の設定(Col?=<フィールド名> <属性・桁数>)
    ' 属性  テキスト        Text
    '       YES/NO型        Bit
    '       整数型          Byte,Short,Long
    '       通貨型          Currency
    '       浮動小数点      Single,Double
    '       日付型          DateTime,Date(yy/mm/dd)
    '       固定長文字列    Char Width <Size>
    '       メモ型          Memo
    
    Print #Handle, "Col1=番号 Text"
    Print #Handle, "Col2=氏名 Text"
    Print #Handle, "Col3=住所 Text"
    Print #Handle, "Col4=年齢 Short"
              
    Close Handle
  
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