Looping through files in directory

NikToo

Board Regular
Joined
Sep 24, 2015
Messages
53
Office Version
  1. 365
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?

VBA Code:
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
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

NikToo

Board Regular
Joined
Sep 24, 2015
Messages
53
Office Version
  1. 365
This works. Not sure why.

VBA Code:
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
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,126,981
Messages
5,621,956
Members
415,869
Latest member
LWSkinner

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top