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

时间:2016-04-07 20:45:18

标签: excel vba excel-vba

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

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

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

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

2 个答案:

答案 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