VBS 批量读取文件夹内所有的文本到Excel的脚本

'This code is done by KangKang@ 
Option explicit ‘This is optional, but better to use. 
Dim FolderPath,Folder 
Dim fso,File,Files 
Dim fileNums 
Dim FileString() 
Dim i 
Dim ii 

i=0 
FolderPath="E:/TDDOWNLOAD/aa/" 

'**********************1.To create the FileSystemObject object******************************** 
Set fso= CreateObject("Scripting.FileSystemObject")'This is the way to create FileSystemObjecy 
‘这句话在Excel VBA中也可以如此定义来引用FSO! 
'Scripting是类库的名字,filesystemobject是所引用的对 '象, 说明了此时VBA所用的对象不是自带的，而是引用 '外界的。 

'**********************2.To create the Folder and File object********************************* 
If fso.FolderExists(FolderPath) Then 
Set Folder = fso.GetFolder(FolderPath) 'This set command is neccessary! 
Set Files=Folder.Files 
fileNums=Files.Count 
'Msgbox fileNums 
For Each File In Folder.Files 
if right(File.name,2)="rm" then 
ReDim Preserve FileString(i) 'This is a Dynamic Array, so we should use the Redim command 
'Be careful of the Preserve word, important!!!! 
FileString(i)=File.Name 
'MsgBox i & " " & FileString(i) 
i=i+1 
fileNums=i 
End if 
Next 
End If 

'**********************3.Create Excel and stroe the file name in it*************************** 
Dim objExcel 
Dim objWorkbook 

Set objExcel = WScript.CreateObject("Excel.Application") 
objExcel.Workbooks.Add 
objExcel.Visible=True 

Set objWorkbook = objExcel.ActiveWorkbook 
For ii=1 to fileNums 
objWorkbook.Worksheets(1).Cells(ii,1)=FileString(ii-1) 
Next 
objWorkbook.Worksheets(1).Range("A1:A1").Columns.AutoFit 
objExcel.DisplayAlerts = False 
objWorkbook.SaveAs(FolderPath & "xiao.xls") 

objWorkbook.Close()'Close the Workbook 
objExcel.Quit()'Quit 
Set fso=Nothing 

'**********************4.Open the files and read the first line.****************************** 
Dim Range 
Dim Range_i 
Dim mfile 
Dim sline 
Dim iii 

set fso=createobject("scripting.filesystemobject") 
Set objExcel = WScript.CreateObject("Excel.Application") 
objExcel.Visible=True 
objExcel.Workbooks.open(FolderPath & "xiao.xls") 

Set objWorkbook = objExcel.ActiveWorkbook 
Set Range = objWorkbook.Activesheet.range("A1:A11") 

For Range_i=1 to fileNums 
set mfile=fso.opentextfile(Range(Range_i).value) 
msgbox Range_i & " " & Range(Range_i).value 
for iii=1 to 1 
sline=mfile.readline 
objWorkbook.Worksheets(1).Cells(Range_i,2)=sline 
Next 
mfile.close 
Next 
objWorkbook.Worksheets(1).Range("B1:B1").Columns.AutoFit 
objExcel.DisplayAlerts = False 
objWorkbook.SaveAs(FolderPath & "xiao.xls") 

objWorkbook.Close()'Close the Workbook 
objExcel.Quit()'Quit 
Set fso=Nothing