CODEWITHSUNDEEP
excelvbaloops
Tommeck37
Tommeck37

Reputation: 131

loop only through selected files

Do you know how to loop only through selected files in a folder with VBA? I managed to do the code for looping through all the files. However, I'd like to shorten the time of processing to make it open only the files which I specify in the code.

Sub CopyDataFromCSTR()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim i As Long



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


myPath = ActiveWorkbook.Path & "\"


  myExtension = "*.xlsx*"

  myFile = Dir(myPath & myExtension)

'attempt to set a criteria for the files to open - however the loop ends at first attempt
  Do While InStr(myFile, "Trans") <> 0

      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'do something to the opened file



      wb.Close SaveChanges:=False


      DoEvents


      myFile = Dir
  Loop

  Set wb = Nothing

  MsgBox ("Done!")

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




End Sub

Upvotes: 1

Views: 1593

Answers (3)

Stupid_Intern
Stupid_Intern

Reputation: 3450

For example, I would like to open only files that among other characters in file's name has specific string; "trans". The file name could look like this: 20170311sdfsdfTransfasdfasd.xlsx or 20170310fasdfTransasdfaw.xlsx. Is there any way to incorporate INSTR function in recognizing the files we want to select?

Sub CopyDataFromCSTR()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim i As Long

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

myPath = ActiveWorkbook.Path & "\"

  myExtension = "*.xls*"
  myFile = Dir(myPath & myExtension)


  Do While myFile <> 0

 if instr(myFile, "trans") > 0 then    'Check condition inside the loop instead of ending the do-while loop abruptly

      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    'do something to the opened file
      wb.Close SaveChanges:=False
      DoEvents

   End if

      myFile = Dir
  Loop

  Set wb = Nothing    
  MsgBox ("Done!")

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

End Sub

Upvotes: 0

Winterknell
Winterknell

Reputation: 585

This is modified from my favourite treewalking routine. I've omitted the recursive call so it just searches the specified folder. Normally I set References, but here I've late bound the scripting objects.

For this POC we just open the file, debug.print the name and close it

Sub ScanFldr(sFld As String, sPat As String)
    Dim fso As Object, fld As Object, fil As Object
    Dim wkb As Excel.Workbook

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(sFld)
    If Right(sFld, 1) <> "\" Then sFld = sFld & "\"

    For Each fil In fld.Files
        If fil.Name Like sPat And Not (fil.Name Like "~$*" or fil.Name = thisWorkBook.Name) Then
            Set wkb = Workbooks.Open(Filename:=sFld & fil.Name, ReadOnly:=True, UpdateLinks:=False)
            Debug.Print "Opened " & fil.Name
            wkb.Close savechanges:=False
        End If
        DoEvents
    Next
    Set wkb = Nothing
    Set fso = Nothing
End Sub

call as e.g.

ScanFldr thisworkbook.path, "*.xlsx*"

Note that to use thisworkbook.path then you need to save the workbook containing the code before running the macro.

Upvotes: 1

M1chael
M1chael

Reputation: 251

Where you have * before the . in Replace myExtension = ".xlsx", replace the * with a file mask for the file. For example: "FilesLikeThis.xlsx*" You may want to rename the variable to FileMask or something more appropriate.

For example, for files starting with the word hello only:

    myFileName = "hello*"
    myExtension = "xlsx*"
    myFile = Dir(myPath & myFileName & "." & myExtension)

Don't forget to add a Dim for the new variable.

Upvotes: 1

Related Questions