| 标题 | VBS 批量读取文件夹内所有的文本到Excel的脚本 |
| 内容 | 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 |
| 随便看 |
|
在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。