Excel VBA - Multiple Dir() in Same Folder

Question

I am working on this codes, but can't make it work.

Here is my working code:

Sub AREA21()


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim regFile As String
Dim myExtension As String
Dim RegX As String

'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    ThisWorkbook.UpdateLinks = xlUpdateLinksNever

myPath = "C:\Users\Aspire E 14\Desktop\xx\xxx\"

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*area trees yield of NFICCs in *.xls*"
  RegX = "*area trees yield of NFICCs in REG*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)
  regFile = Dir(RegX & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
    If myFile = regFile Then GoTo skipRegFile
    
      Set wb = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=False)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'my codes here
    For i = 1 To Sheets.Count
    
        Sheets(i).Select
  
    Next i
    

        
     'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents
      
skipRegFile:
    'Get next file name
      myFile = Dir

  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    ThisWorkbook.UpdateLinks = xlUpdateLinksAlways



End Sub

Here is the sample folder:

Files with "REG**" are just the summary of respective provinces.

My goal is to run the codes in provincial files, and skip opening the file if it is a regional summary. However, problems occur when getting the next file in Dir statement as it appears blank.

Still looking for a better work around.

Why don't you just use Like or InStr to test if the filename contains REG, instead of trying to use Dir twice: If Not myFile Like "*REG*" Then. — BigBen
– BigBen, Commented Jan 28, 2021 at 3:34
Thanks @BigBen! I had to remove the "Not" as it runs on files with "Reg". Now it runs on files doesn't have "Reg" on it. — EibwenVBA
– EibwenVBA, Commented Jan 28, 2021 at 3:50
If you keep the Not in there, you can get rid of your error handler completely: If Not myFile Like "*REG*" Then... keep processing ... End If, myFile = Dir. — BigBen
– BigBen, Commented Jan 28, 2021 at 3:51

Ricardo Diaz · Accepted Answer · 2021-01-28 13:05:25Z

You can adapt this code to suit your needs.

Some suggestions:

Name your variables to something meaningful (sh is hard to understand, sourceRange it's easier)
Indent your code properly (you can use Rubberduckvba.com) to help you with data
Try to break your code into pieces (e.g. first validate, then prepare, then add items)
Comment your code

Code:

Public Sub Area21()

    ' Basic error handling
    On Error GoTo CleanFail

    ' Turn off stuff
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    ThisWorkbook.UpdateLinks = xlUpdateLinksNever

    ' Define files path
    Dim filesPath As String
    filesPath = "C:\TEMP\"
    
    ' Define file name string to match
    Dim fileString As String
    fileString = "demo"
    
    ' Define file name
    Dim fileName As String
    fileName = Dir(filesPath, vbNormal)
    
    ' Loop through files
    Do While fileName <> ""
        'Set variable equal to opened workbook
        If InStr(LCase(fileName), LCase(fileString)) > 0 Then
        
            ' Set a reference to the workbook
            Dim targetWorkbook As Workbook
            Set targetWorkbook = Workbooks.Open(fileName:=filesPath & fileName, UpdateLinks:=False)
            
            'Ensure Workbook has opened before moving on to next line of code
            DoEvents
            
            ' DO SOMETHING WITH THE WORKBOOK
            
            'Save and Close Workbook
            targetWorkbook.Close SaveChanges:=True
            
            'Ensure Workbook has closed before moving on to next line of code
            DoEvents
            
        End If
        
        fileName = Dir()
    Loop

CleanExit:
    ' Turn on stuff
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    ThisWorkbook.UpdateLinks = xlUpdateLinksAlways
    Exit Sub
    
CleanFail:
    MsgBox "Error " & Err.Description
    GoTo CleanExit
End Sub

Thank you very much for this @Ricardo Diaz! Suits very well.

Collectives™ on Stack Overflow

Excel VBA - Multiple Dir() in Same Folder

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related