Question

EXCEL2010 vba 循环打开某些文件夹下的excel文件

DirC函数是读取公交车这个文件夹下面所有文件夹的名字，并且存储在目录.xlsx中，这个函数执行是成功。
model函数是循环打开公交车文件夹下每个文件夹里面的目录1.xlsx，打开之后并关闭。运行程序时，发现以下语句是错误的。希望老师能帮我修改以下。
Workbooks.Open ("C:\Documents and Settings\Administrator\桌面\调查数据\编程程序\公交车\" & str1 & "目录1.xlsx")

Sub DirC()
Mypath = "C:\Documents and Settings\Administrator\桌面\调查数据\编程程序\公交车\"
Workbooks.Open ("C:\Documents and Settings\Administrator\桌面\调查数据\编程程序\公交车\目录.xlsx")
MyName = dir(Mypath, vbDirectory) ' 找寻第一项。
i = 1
Do While MyName <> "" ' 开始循环。
' 跳过当前的目录及上层目录。
If MyName <> "." And MyName <> ".." Then
' 使用位比较来确定 MyName 代表一目录。
If (GetAttr(Mypath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' 如果它是一个目录，将其名称显示出来。
Workbooks("目录.xlsx").Sheets(1).Cells(i - 2, 1).Value = MyName
End If
End If
MyName = dir ' 查找下一个目录。
i = i + 1
Loop
End Sub

Sub model()
'
' model Macro
'
' 快捷键: Ctrl+p
'
Application.ScreenUpdating = False
Dim str1 As String
i = 1
Workbooks.Open ("C:\Documents and Settings\Administrator\桌面\调查数据\编程程序\公交车\目录.xlsx")
While Workbooks("目录.xlsx").Sheets(1).Cells(i, 1).Value <> ""
str1 = Workbooks("目录.xlsx").Sheets(1).Cells(i, 1).Value
Workbooks.Open ("C:\Documents and Settings\Administrator\桌面\调查数据\编程程序\公交车\" & str1 & "目录1.xlsx")
Workbooks("目录.xlsx").Save
Workbooks("目录.xlsx").Close
i = i + 1
Wend
End Sub

Answer 1

就是遍历文件夹嘛,关键代码如下
在工程-引用里添加 microsoft scripting run time
然后用下面的两个函数递归遍历 就可以了
sub main()
Dim objFSO As Object
Dim objTemplateFolder As Object
Set objFSO = New Scripting.FileSystemObject
Set objTemplateFolder = objFSO.GetFolder(“D:\”)
getFiles objTemplateFolder
end sub

Sub getFiles(ByRef theFolder As Object)
Dim folder As Object
Dim c As New Scripting.FileSystemObject
‘此处执行你的操作：打开关闭文件夹，取名字等
For Each folder In theFolder.subFolders
getFiles folder ’递归遍历子文件夹
Next
End Sub

Answer 2

str1 两边有 “\" 吗？？？？
而且 “目录1.xlsx” 也没有被关闭啊。每次关闭的是 “目录.xlsx" 。
系统是不能打开同名文件的。
关闭的时候可以这样关闭 :
set wb = Workbooks.Open ("C:\Documents and Settings\Administrator\桌面\调查数据\编程程序\公交车\" & str1 & "目录1.xlsx")
wb.Close Savechanges:=True