回来主页
当时方位: manbetx万博官网 > > Excel VBA教程 >

Excel批量获取指定目录下文本文件内容VBA代码

时刻:2014-06-18 23:06来历:manbetx万博官网网 www.fwnyp.com修正:麦田守望者

今日帮一位网友弄的,A列为文件名,B列为对应的文本文件内容。此代码只适用于Excel2003及以下版别,因FileSearch办法被微软阉割了。
Sub listfile()
''''''''''''''''''''''''''''''''''''''''''''''
' 批量获取指定目录下一切文本文件名和内容 '
' '
''''''''''''''''''''''''''''''''''''''''''''''
Dim fs, fso, fl
Dim mypath As String
Dim theSh As Object
Dim theFolder As Object
Dim strtmp As String
Application.ScreenUpdating = False
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject") '设置查找途径
Set theSh = CreateObject("shell.application")
Set theFolder = theSh.BrowseForFolder(0, "", 0, "")
If Not theFolder Is Nothing Then
mypath = theFolder.Items.Item.Path
End If
'查找开端
Set fs = Application.FileSearch
With fs
.NewSearch
.SearchSubFolders = True '查找子目录
.LookIn = mypath '查找途径
.FileName = "*.txt" '查找文件类型为txt
If .Execute(SortBy:=msoSortByFileName) = 0 Then
C = .FoundFiles.Count '计算查找到的文件个数
For i = 1 To C
strtemp = .FoundFiles(i) '设置临时文件
n = InStrRev(strtemp, "\") '获取文件途径长度(不包括文件名)
'获取文件名及扩展名
strfilename = Replace(strtemp, Left(strtemp, n), "")
'从A2单元格开端输出格局为:文件名
Cells(i + 1, 1) = Left(strfilename, Len(strfilename) - 4)
Set fl = fso.opentextfile(strtemp, 1)
strtmp = fl.readall '读取文本内容
Range("b" & i + 1) = strtmp 'B2开端写入内容
fl.Close
Next
Else
MsgBox "该文件夹里没有符合要求的文件!"
End If
End With
Set fs = Nothing
Application.ScreenUpdating = True
End Sub

------分隔线----------------------------
标签(Tag):excel excel2007 excel2010 excel2013 excel2003 excel技巧 excel实例教程
------分隔线----------------------------
引荐内容
猜你感兴趣