Looping through files in directory

[NikToo]

I have this bit of code which should theoretically loop through all files in a specified folder, but when I run it, it just opens the same file over and over. It has the week numbers specified as w, so go through the startWeek through to the endWeek, open the files, paste them into a temporary workbook, end. The loop just seems to be stuck... Any ideas what I'm missing?

Sub ImportAllFiles()

Dim StartWeek As Long
Dim EndWeek As Long
Dim Year As Long
Dim DailyLeadsDirectory As String
Dim StrFile As String
Dim TempWb As String
Dim lastRow As String
Dim ActiveDir As String

'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Application.Calculation = xlCalculationManual

StartWeek = Range("B1").Value
EndWeek = Range("B2").Value
Year = Range("B3").Value
DailyLeadsDirectory = Range("B4").Value

Workbooks.Add
ActiveWorkbook.Activate

TempWb = ActiveWorkbook.Name

For w = StartWeek To EndWeek

ActiveDir = DailyLeadsDirectory & "\" & Year & "\" & "Week " & w & "\"

StrFile = Dir(ActiveDir & "\*" & "*Becoming*")
    
    Do While Len(StrFile) > 0
        
    Workbooks.Open Filename:=ActiveDir & StrFile
    
    Workbooks(StrFile).Activate
        Range("A2").Select
        Range(ActiveCell, Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select
        Selection.Copy
    
    Workbooks(TempWb).Activate
        Range("A1").Select
        lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
        If lastRow = 2 Then
            lastRow = 1
        End If
        
        Range("A" & lastRow).Select
        Selection.PasteSpecial
    
    Application.CutCopyMode = False
    
    Workbooks(StrFile).Close
    
    Loop
  
Next w

'Application.EnableEvents = True
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True


End Sub

 

[NikToo]

This works. Not sure why.

Sub ImportAllFiles()

Dim StartWeek As Long
Dim EndWeek As Long
Dim Year As Long
Dim DailyLeadsDirectory As String
Dim StrFile As String
Dim TempWb As String
Dim lastRow As String
Dim ActiveDir As String

'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Application.Calculation = xlCalculationManual

StartWeek = Range("B1").Value
EndWeek = Range("B2").Value
Year = Range("B3").Value
DailyLeadsDirectory = Range("B4").Value

Workbooks.Add
ActiveWorkbook.Activate

TempWb = ActiveWorkbook.Name

For w = StartWeek To EndWeek

ActiveDir = DailyLeadsDirectory & "\" & Year & "\" & "Week " & w & "\"

StrFile = Dir(ActiveDir & "\*Becoming*")
    
    While StrFile <> ""
            
    Workbooks.Open Filename:=ActiveDir & StrFile
    
    Workbooks(StrFile).Activate
        Range("A2:P2", Range("A2:P2").End(xlDown)).Select
        Selection.Copy
    
    Workbooks(TempWb).Activate
        Range("A1").Select
        lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
        If lastRow = 2 Then
            lastRow = 1
        End If
        
        Range("A" & lastRow).Select
        Selection.PasteSpecial
    
    Application.CutCopyMode = False
    
    Workbooks(StrFile).Close
    
    StrFile = Dir
    
    Wend
    
Next w

'Application.EnableEvents = True
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True


End Sub

 

[John_w]

You were missing StrFile = Dir which returns the next file.