Loop Through All files in a a folder skip if file already using

Ocicek

New Member
Joined
May 22, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
Hello All

I have a code loop through all excel file in a given folder.

But I have problem if some files opened from that folder the loop is getting crash.

VBA Code:
Sub LoopAllExcelFilesInFolder()


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

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

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

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

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'Change First Worksheet's Background Fill Blue
      wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

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

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

End Sub

Where should we add a condition in the code to solve this problem?
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,142
Office Version
  1. 2010
Platform
  1. Windows
Hi,​
try GetObject - to see in VBA help - rather than Workbooks.Open …​
 

Ocicek

New Member
Joined
May 22, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
Dear Marc Thank you for you answer. I'm running this code from microsoft Access and I am not sure
VBA Code:
GetObject
is work by MS Access or I can't describe it. Because when I use
VBA Code:
GetObject
I'm getting argument not found error.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,142
Office Version
  1. 2010
Platform
  1. Windows
As I wrote « to see in VBA help » but you did not even read it !​
So according to its help the expected argument is pathname rather than Filename !​
Or just following its sample remove Filename from the codeline …​
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,697

ADVERTISEMENT

First, place the following function in a regular module...

VBA Code:
Public Function IsFileOpen(FileName As String) As Boolean

'Bob Philips
'VBA Express
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=468

    Dim iFilenum As Long
    Dim iErr As Long
    
    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Input Lock Read As #iFilenum
    Close iFilenum
    iErr = Err
    On Error GoTo 0
    
    Select Case iErr
        Case 0:    IsFileOpen = False
        Case 70:   IsFileOpen = True
        Case Else: Error iErr
    End Select
    
End Function

Then amend your loop as follows...

VBA Code:
'Loop through each Excel file in folder
  Do While myFile <> ""
    If Not IsFileOpen(myPath & myFile) Then
        'etc
        '
        '
    End If

    'Get next file name
      myFile = Dir
  Loop

Hope this helps!
 

Ocicek

New Member
Joined
May 22, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
MA
As I wrote « to see in VBA help » but you did not even read it !​
So according to its help the expected argument is pathname rather than Filename !​
Or just following its sample remove Filename from the codeline …​

Dear @Marc L I read your messages. I already research solution of this issue more than 18 hours included VBA help. And unfortunately I'm not a programmer. And thanks for your time.
 

Ocicek

New Member
Joined
May 22, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
Dear @Domenic it seemed help. Thanks.

I added fireflie function on a new module.Than integrated your part to my Loop.

But that's warning me even there is not any open excel insistence hidden or not. Maybe I putted your code on wrong place. I am really sorry for being new on VB.

My code is:
VBA Code:
Option Compare Database

Function P_ExcelLoop()

Dim wb As Workbook

Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
  
myPath = Forms!Payl_Donem_Secimi!Path_3_Ay

myExtension = "*.xls*"

myFile = Dir(myPath & myExtension)


  Do While myFile <> ""
      
      If Not IsFileOpen(myPath & myFile) Then
      MsgBox ("Some files is in use")
      
      Close Workbook
      wb.Close SaveChanges:=False
      
    End If
    
      Set wb = Workbooks.Open(FileName:=myPath & myFile)
    
      DoEvents
      
If Range("A1").Value <> "Bina" Then

'MsgBox "This file is already processed before"

     Close Workbook
      wb.Close SaveChanges:=False
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
      
Else

'MsgBox myFile & " Paylaşım tablosu düzenleniyor."
'Logo ve başlık için yeni satır ekle
    Range("A1").EntireRow.Insert
    Rows("1:1").RowHeight = 61


    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
End If
  Loop

  MsgBox "PayProeccisng excel file is done!"
  
  Application.FollowHyperlink myPath


End Function
First, place the following function in a regular module...

VBA Code:
Public Function IsFileOpen(FileName As String) As Boolean

'Bob Philips
'VBA Express
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=468

    Dim iFilenum As Long
    Dim iErr As Long
   
    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Input Lock Read As #iFilenum
    Close iFilenum
    iErr = Err
    On Error GoTo 0
   
    Select Case iErr
        Case 0:    IsFileOpen = False
        Case 70:   IsFileOpen = True
        Case Else: Error iErr
    End Select
   
End Function

Then amend your loop as follows...

VBA Code:
'Loop through each Excel file in folder
  Do While myFile <> ""
    If Not IsFileOpen(myPath & myFile) Then
        'etc
        '
        '
    End If

    'Get next file name
      myFile = Dir
  Loop

Hope this helps!
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,697
Your loop should be as follows...

VBA Code:
  Do While myFile <> ""
      
      If Not IsFileOpen(myPath & myFile) Then
      
        Set wb = Workbooks.Open(FileName:=myPath & myFile)
        
        DoEvents
        
        If Range("A1").Value = "Bina" Then
            Range("A1").EntireRow.Insert
            Rows("1:1").RowHeight = 61
        End If
      
        wb.Close SaveChanges:=False
        
        DoEvents
      
    End If

    'Get next file name
      myFile = Dir

  Loop
 

Forum statistics

Threads
1,136,445
Messages
5,675,900
Members
419,591
Latest member
mersanko

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