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

[Ocicek]

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.

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?

 

[Marc L]

Hi,​

​

try GetObject - to see in VBA help - rather than Workbooks.Open …​

 

[Ocicek]

Dear Marc Thank you for you answer. I'm running this code from microsoft Access and I am not sure

GetObject

is work by MS Access or I can't describe it. Because when I use

GetObject

I'm getting argument not found error.

 

[Marc L]

​

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]

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

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...

'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]

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]

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:

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...

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...

'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]

Your loop should be as follows...

  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