我一直在寻找可以打开文件夹,打开.xlsx文件,运行我的代码,关闭.xlsx文件,然后转到下一个文件夹(不是子文件夹)的VBA脚本。我只是想不出来。我的文件夹结构如下:
C:\ Files \ [数百个文件夹] \ name.xlsx
每个文件夹中都有一个.xlsx文件,我需要在所有这些文件上运行我的代码(大约1000个文件夹,每个文件夹有1个文件)。
任何和所有帮助将不胜感激!谢谢!
答案 0 :(得分:0)
希望这会有所帮助。你可以相应推断。
Sub Openfile()
Dim MyFolder As String
Dim MyFile As String
'The code below opens up the specified folder.
'Replace the pathway with your own.
'Keep the explorer.exe string.
Call Shell("explorer.exe" & " " & "C:\Users\mvanover\Desktop\Test", vbNormalFocus)
'The code below opens up every excel file with .xlsx extension in the MyFolder path.
MyFolder = "C:\Users\mvanover\Desktop\Test"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub
<强>更新强>
您还可以在启用宏的工作簿中的单元格中输入所有文件夹名称,并将这些值设置为宏中的对象。然后,您可以将该对象添加到位于shell函数中的字符串的末尾。示例如下所示:
Call Shell("explorer.exe" & " " & "C:\Users\mvanover\Desktop\Test\" & FolderName, vbNormalFocus)
然后,您可以设置一个简单的循环,遍历每个文件夹名称并相应地打开它们。你在循环中的代码包括打开所有/一个excel工作簿,运行你想要运行的代码,以及关闭每个文件夹。关闭文件夹的代码如下所示:
Call Shell("explorer.exe" & " " & "C:\Users\mvanover\Desktop\Test\" & FolderName, vbNormalFocus)
DoEvents
Hwnd = apiFindWindow("CabinetWClass", vbNullString)
Dim retval As Long
If (Hwnd) Then
retval = apiPostMessage(Hwnd, CLOSE_WIN, 0, ByVal 0&)
End If
在子语句之前添加下面显示的代码,或结束文件夹代码不起作用:
Private Const CLOSE_WIN = &H10
Dim Hwnd As Long
Private Declare Function apiFindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, _
ByVal lpWindowName As String) _
As Long
Private Declare Function apiPostMessage _
Lib "user32" Alias "PostMessageA" _
(ByVal Hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
对所有这些新代码感到抱歉。与打开文件夹相比,关闭文件夹实际上要困难得多。当我使用F8通过结束代码进行调试时,它可以工作。
答案 1 :(得分:0)
这使用一个列表“mfList”,它根据以“C:\ Files \”开头的条件创建,并且在该点之后只有一个子文件夹。所有这些文件夹都“有资格”记录在列表中。获得列表后,您可以浏览每个路径,并为该路径中的每个.xlsx文件运行代码。我拿了一个程序并对其进行了操作,所以我还没有对它进行过测试,但希望这能给你提供想法,并指出你正确的方向。 (这些都是函数,你必须创建调用它们的子程序,当然,还有适当的变量)
Function MapFolders(fPath As String, Optional ByRef mfList As Collection, Optional NotTopLevel As Boolean)
Dim i As Long, Temp As String, nList As New Collection, mfVariant As Variant
On Error Resume Next: i = mfList.Count: On Error GoTo 0: If i = 0 Then Set mfList = nList
If Left(fPath, 9) = "C:\Files\" And InStr(Right(fPath, Len(fPath) - 9), "\") = InStrRev(Right(fPath, Len(fPath) - 9), "\") And Not InStr(Right(fPath, Len(fPath) - 9), "\") = 0 Then mfList.Add fPath
i = 1: Temp = SubFolder(fPath, i)
While Len(Temp) > 0
MapFolders Temp, mfList, True
i = i + 1: Temp = SubFolder(fPath, i)
Wend
If (Not mfList.Count = 0) And (Not NotTopLevel) Then Set mfVariant = Nothing: Set mfList = nList
Set nList = Nothing
End Function
Function SubFolder(fPath As String, i As Long) As String
Dim FSO As New FileSystemObject, FSOFolder As Object, FSOSubFolder As Object, FCount As Integer, j As Long
SubFolder = "": On Error Resume Next: Set FSOFolder = FSO.GetFolder(fPath): On Error GoTo 0
If FSOFolder Is Nothing Then Exit Function
On Error Resume Next: FCount = FSOFolder.SubFolders.Count: On Error GoTo 0
If i <= FCount Then
For Each FSOSubFolder In FSOFolder.SubFolders
j = j + 1: If j = i Then Exit For
Next FSOSubFolder
SubFolder = FSOSubFolder.Path & "\"
End If
Set FSO = Nothing: Set FSOFolder = Nothing
End Function