vba 遍历一个文件夹（可浏览指定），子目录不需要遍历，然后把文件名和路径存入数组。

如题所述

举报该问题

推荐答案 2011-12-15

贴个VBS代码的吧，懒得改成VBA的了，主要部分应该是一样的。

Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", OPTIONS, strPath)
If objFolder Is Nothing Then
Wscript.Quit
End If
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path

Set ws=WScript.CreateObject("wscript.shell")
w=ws.CurrentDirectory
Set fso=WScript.CreateObject("scripting.filesystemobject")
Set fs=fso.GetFolder(objPath)
Set f=fs.SubFolders

set ie=wscript.createobject("internetexplorer.application","event_") '创建ie对象'

ie.menubar=0 '取消菜单栏'
ie.addressbar=0 '取消地址栏'
ie.toolbar=0 '取消工具栏'
ie.statusbar=0 '取消状态栏'
ie.width=600 '宽600'
ie.height=400 '高400'
ie.resizable=0 '不允许用户改变窗口大小'
ie.navigate "about:blank" '打开空白页面'
ie.left=fix((ie.document.parentwindow.screen.availwidth-ie.width)/2) '水平居中'
ie.top=fix((ie.document.parentwindow.screen.availheight-ie.height)/2) '垂直居中'
ie.visible=1 '窗口可见'
with ie.document '以下调用document.write方法，'

.write "<BODY>"
.write "Folder Size List"
.write "<table border="
.write "<TABLE>"

Dim FolderSize
on error resume next
For Each uu In f
If uu.Attributes<>22 then

.write "<TR>"
.write "<TD>" & uu.Path & "</TD>"
.write "<TD>" & CInt(uu.Size/1024/1024) & "MB" & "</TD>"
.write "</TR>"
End if
Next

.write "</TABLE>"
.write "</BODY>"
.write "</br>"

MsgBox "read finish"

End With

温馨提示：答案为网友推荐，仅供参考

当前网址：http://99.wendadaohang.com/zd/zBe77jOjW.html

其他回答

第1个回答 2011-12-14

用dir函数，在循环中把dir返回的文件名赋给数组本回答被网友采纳

第2个回答 2011-12-25

With Application.FileSearch
.NewSearch
.LookIn = mainpath
.SearchSubFolders = True
.Filename = "*.*"
FileType = msoFileTypeAllFiles 'msoFileTypeExcelWorkbooks
jdjd = .Execute()
If .Execute() > 0 Then
For I = 1 To .FoundFiles.Count
On Error Resume Next

If Workbooks("CDMA_CDD_TOOLS").Sheets("tools").hssite.Value = True Then
Workbooks.OpenText Filename:=.FoundFiles(I), _
DataType:=xlDelimited, Space:=True, ConsecutiveDelimiter:=True

'Workbooks.OpenText Filename:=.FoundFiles(I), DataType:=xlDelimited, Space:=True, ConsecutiveDelimiter:=True
tnameB = ParseFileName(.FoundFiles(I))
Set WSB = Workbooks(tnameB)
Call FormatHsSite.formatsheets
tnamea = Trim(Mid(Cells(1.2), 4, 30))
scopyHS WSA, WSB, tnamea, tnameB
End If
dk = 1
If Workbooks("CDMA_CDD_TOOLS").Sheets("tools").ipsite.Value = True Then
Set WSB = Workbooks.Open(Filename:=.FoundFiles(I))
tnamea = ParseFileName(.FoundFiles(I))
tnameB = "Sheet0"
scopyIP WSA, WSB, tnamea, tnameB
wsbname = ""
End If

Application.StatusBar = "正在处理：第" & I & "个文件"
Application.ScreenUpdating = False

Next I
Else
MsgBox "Folder " & sFolder & " contains no required files"
End If

相似回答

大家正在搜