On Error Resume Next 
'Code By NetPatch 
Set Arg=Wscript.Arguments 
If Arg.Count=0 Then Wscript.Quit 
Set Fso = CreateObject("Scripting.FileSystemObject") 
Set Conn = CreateObject("ADODB.Connection") 
Set Rs = CreateObject("ADODB.Recordset") 
path=left(Arg(0),InstrRev(Arg(0),"/")) 
Fname=replace(Arg(0),path,"") 
i=0 
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&path&";Extended Properties=""text;HDR=NO;FMT=Delimited""" 
'Rs.Open "Select count(*) FROM " & Fname,_ 
'Conn, 3, 3, &H0001 
'allline=rs(0) 
Rs.Open "Select * FROM " & Fname,_ 
Conn, 3, 3, &H0001 
'MsgBox rs(0).name 
Do Until Rs.EOF 'N/P 
Do Until n=5000 '要分割的行數 
Set MyTables = fso.CreateTextFile(arg(0)&i&".txt",true) 
MyTables.WriteLine Rs.Fields.Item(0).Value 
Rs.MoveNext 
n=n+1 
loop 
MyTables.Close 
Set MyTables = Nothing 
n=0 
i=i+1 
Loop 
Rs.Close 
Conn.Close 
Set fso = Nothing 
Set Rs = Nothing 
Set Conn = Nothing 
Wscript.echo "整理完畢！"