Excel VBA - 文本文件和文件夹操作实例集锦(16)

MyName = Dir '继续遍历寻找 Loop

I = I + 1 Loop

Did.Add (\文件清单\'以查找D盘下所有EXCEL文件为例 For Each Ke In Dic.keys

MyFileName = Dir(Ke & \ Do While MyFileName <> \

Did.Add (Ke & MyFileName), \ MyFileName = Dir Loop Next

For Each Sh In ThisWorkbook.Worksheets If Sh.Name = \文件清单\ Sheets(\文件清单\ F = True Exit For Else

F = False End If Next

If Not F Then

Sheets.Add.Name = \文件清单\ End If

Sheets(\文件清单\ TT = Time - T

MsgBox Minute(TT) & \分\秒\End Sub

‘红色代码由大灰狼增加，可选择文件夹 Sub Test() '使用双字典，旨在提高速度

Dim MyName, Dic, Did, I, T, F, TT, MyFileName 'On Error Resume Next

Set objShell = CreateObject(\

Set objFolder = objShell.BrowseForFolder(0, \选择文件夹\ If Not objFolder Is Nothing Then lj = objFolder.self.Path & \ Set objFolder = Nothing Set objShell = Nothing

T = Timer

Set Dic = CreateObject(\ '创建一个字典对象 Set Did = CreateObject(\ Dic.Add (lj), \ I = 0

Do While I < Dic.Count

Ke = Dic.keys '开始遍历字典

MyName = Dir(Ke(I), vbDirectory) '查找目录 Do While MyName <> \

If MyName <> \

If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then '如果是次级目录

Dic.Add (Ke(I) & MyName & \就往字典中添加这个次级目录名作为一个条目

End If End If

MyName = Dir '继续遍历寻找 Loop I = I + 1 Loop

Did.Add (\文件清单\ '以查找D盘下所有EXCEL文件为例 For Each Ke In Dic.keys

MyFileName = Dir(Ke & \ Do While MyFileName <> \

Did.Add (Ke & MyFileName), \ MyFileName = Dir Loop Next

For Each Sh In ThisWorkbook.Worksheets If Sh.Name = \文件清单\ Sheets(\文件清单\ F = True Exit For Else

F = False End If Next

If Not F Then

Sheets.Add.Name = \文件清单\ End If Sheets(\文件清单\1) WorksheetFunction.Transpose(Did.keys) TT = Timer - T

MsgBox TT 'Minute(TT) & \分\秒\End Sub

40，将文本文件读入数组(50万数据)

‘http://club.excelhome.net/viewthread.php?tid=643238&pid=4365125&page=2&extra=

=