Open folder, open file, run code, close file, go to next folder - vba

Question

I've been looking around for a VBA script that will open a folder, open a .xlsx file, run my code, close the .xlsx file, and go to the next folder (not subfolder). I just can't figure it out. My folder structure is as follows:
C:\Files\[hundreds of folders]\name.xlsx
Each folder has a .xlsx file in it and I need to run my code on all of these files (about 1000 folders each with 1 file).
Any and all help would be greatly appreciated! Thanks!

Answer 1

This uses a list "mfList" that gets created based on the criteria that it begins with "C:\Files\" and has exactly one sub folder after that point. All such folders "qualify" to be recorded in the list. Once you have the list, you can go through each of the paths, and for every .xlsx file in that path, run your code. I took one of my programs and manipulated it, so I haven't actually tested it, but hopefully this gives you the idea, and points you in the right direction. (And again these are functions, you'd have to create the subroutine that calls them, of course, with appropriate variables)
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

Answer 2

Hope this helps. You can extrapolate accordingly.
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
Update:
You could also input all the folder names in cells located in your macro-enabled workbook and set those values to the an object in your macro. You can then add that object to the end of your string located in the shell function. An example is shown below:
Call Shell("explorer.exe" & " " & "C:\Users\mvanover\Desktop\Test\" & FolderName, vbNormalFocus)
You could then set up an easy loop that would go through each folder name and open them accordingly. Your code inside that loop would consist of opening all/one excel workbook(s), running the code you'd like to run, and closing the each folder. The code for closing the folders as well is shown below:
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
Add the code shown below before your sub statement as well or the closing folder code won't work:
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
Sorry about all this new code. It's actually a lot harder to close a folder compared to opening it. When I was debugging through the closing code with F8 it works.