CODEWITHSUNDEEP
vbaexcel
Hal Baggot
Hal Baggot

Reputation: 124

VBA to loop through files in subfolders

I need to amend a column heading in multiple excel files. The files are located in subfolders two levels below the folder I want to loop through (28 .xlsx files in each folder, one folder for each Period).

The file structure is: "c:\...filepath...\Period *\Daily Attributions\*.xlsx"

I have managed to get some code to work that loops through each file in a folder but I need help to repeat the same loop for all the files in each folder.

Here's what I have so far.

Sub FirstLast()
'
' FirstLast Macro
'
  Dim sPath As String
  Dim sFile As String
  Dim wb As Workbook

  sPath = "C:\...filepath...\Period 1\Daily Attributions\"
  sFile = Dir(sPath & "*.xlsx")

Do While sFile <> ""

Set wb = Workbooks.Open(sPath & sFile, UpdateLinks:=False)

    Range("E1").Select
    ActiveCell.FormulaR1C1 = "FirstLast"
    ActiveWorkbook.Save
    ActiveWindow.Close
sFile = Dir

  Loop


End Sub

Upvotes: 0

Views: 3659

Answers (3)

snb
snb

Reputation: 343

Sub M_snb()
  sn=split(createobject("wscript.shell").exec("cmd /c Dir ""C:\...filepath...\Period *\Daily Attributions\*.xls"" /b /s").stdout.readall,vbcrlf)

  for j=0 to ubound(sn)
    with getobject(sn(j))
      .sheets(1).cells(1,5)="firstlast"
      .close -1
    end with
  next
end sub

Upvotes: 1

Amen Jlili
Amen Jlili

Reputation: 1934

This answer is the illustration of my comment above:

I've tested it and it works like charm:

Sub FirstLast()
  Dim sPath As String
  Dim sFile As String
  Dim wb As Workbook
  Dim subfolder As String
  Dim subdir As Collection
  Set subdir = New Collection
  Dim maindir As String: maindir = "D:\main\" 
  'Above line is the main directory which is "C:\...filepath...\"
  subfolder = Dir(maindir, vbDirectory)
  Do While subfolder <> ""
  subdir.Add Item:=subfolder
  subfolder = Dir(, vbDirectory)
  Loop
  ' remove . and ..
  subdir.Remove (1)
  subdir.Remove (1)
  For Each m In subdir
  sPath = maindir & "\" & m & "\Daily Attributes"
  sFile = Dir(sPath & "*.xlsx")
  Do While sFile <> ""
  ' do stuff:
  'Set wb = Workbooks.Open(sPath & sFile, UpdateLinks:=False)
  'Range("E1").Select
  'ActiveCell.FormulaR1C1 = "FirstLast"
  'ActiveWorkbook.Save
  'ActiveWindow.Close
  sFile = Dir
  Loop
  Next


End Sub

Upvotes: 2

Ashwith Ullal
Ashwith Ullal

Reputation: 263

  Sub FirstLast()
'
' FirstLast Macro
'
  Dim sPath As String
  Dim sFile As String
  Dim wb As Workbook

  sPath = "C:\...filepath...\Period 1\Daily Attributions\"
  sFile = Dir(sPath & "*.xlsx")

for i = 1 to 3
'pseudo code 
'"open foldername " & i
'looping through files in folder

Do While sFile <> ""

Set wb = Workbooks.Open(sPath & sFile, UpdateLinks:=False)

Range("E1").Select
ActiveCell.FormulaR1C1 = "FirstLast"
ActiveWorkbook.Save
ActiveWindow.Close
sFile = Dir

 Loop

next i

End Sub

Upvotes: 1

Related Questions