Question

我一直在寻找可以打开文件夹，打开.xlsx文件，运行我的代码，关闭.xlsx文件，然后转到下一个文件夹（不是子文件夹）的VBA脚本。我只是想不出来。我的文件夹结构如下：

C：\ Files \ [数百个文件夹] \ name.xlsx

每个文件夹中都有一个.xlsx文件，我需要在所有这些文件上运行我的代码（大约1000个文件夹，每个文件夹有1个文件）。

任何和所有帮助将不胜感激！谢谢！

Answer 1

希望这会有所帮助。你可以相应推断。

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通过结束代码进行调试时，它可以工作。

Answer 2

这使用一个列表“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

打开文件夹，打开文件，运行代码，关闭文件，转到下一个文件夹

2 个答案: