VBS批量讀取文件夾內(nèi)所有的文本到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