Workbooks.Close Savechanges:=True & Loop NOT working

[JaimeMabini]

Hello,
The code below will display the folder picker dialog box to allow the user to specify the folder (directory) that they want to use. It will then loop through all the files within that folder. It will open the workbook, perform an action and then close it saving the changes made.

(1.) The job performs accordingly to the first workbook in the folder but doesn't loop to the next workbook.
(2.) Also, It doesn't automatically close and save the workbook after the job ends.

Sub AllWorkbooksSecond()

   Dim MyFolder As String 'Path collected from the folder picker dialog
   Dim MyFile As String 'Filename obtained by DIR function
   Dim wbk As Workbook 'Used to loop through each workbook
   
   Dim i As Long
   Dim f As Range, c As Range
   Dim message
   
   Sheets("RDS Converter").Select
   Z = Range("I7").Value 'Row range collected from the RDS Converter sheet
   y = Range("I6").Value 'Path collected from the RDS Converter sheet
   PathName = Range("I5").Value 'Path collected from the RDS Converter sheet
   
   
'On Error Resume Next

Application.ScreenUpdating = False
Application.EnableEvents = False

'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False

   If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
      Exit Sub
   End If
   
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With

MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> ""
   'Opens the file and assigns to the wbk variable for future use
   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
   
   'below is the statements macro to perform
   
   
   With Workbooks.Open(Filename:=MyFolder & MyFile).Sheets("OKTOP® CONFIGURATOR")
   For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
   
   If c.Row > Z Then
            MsgBox ("Row " & Z & " Reached")
    End
    
    
    Else
    
        Set f = Workbooks.Open(PathName & y).Sheets("OKTOP® CONFIGURATOR").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
            
            If Not f Is Nothing Then
                f.EntireRow.Copy
                .Range("A" & c.Row).PasteSpecial xlValues
                .Range("T" & c.Row).Value = "Yes"
                
            Else
                .Range("T" & c.Row).Value = "No"

    End If

End If

Next

End With

wbk.Close Savechanges:=True 'close and save the workbook
f.Close Savechanges:=True 'close and save the workbook
MyFile = Dir 'DIR gets the next file in the folder

Loop

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

I believe this line should do the job but somehow the macro ends before it reaches this lines. it performs the job on the first workbook on the folder but don't close and save and loop through the next workbook.

wbk.Close Savechanges:=True 'close and save the workbook
f.Close Savechanges:=True 'close and save the workbook
MyFile = Dir 'DIR gets the next file in the folder

Loop

Any help will be greatly appreciated.

Thank you in advance.

 

[Anthony47]

Try replacing With Workbooks.Open(Filename:=MyFolder & MyFile).Sheets("OKTOP® CONFIGURATOR") with

With wbk.Sheets("OKTOP® CONFIGURATOR")

Bye

 

[JaimeMabini]

Try replacing With Workbooks.Open(Filename:=MyFolder & MyFile).Sheets("OKTOP® CONFIGURATOR") with

With wbk.Sheets("OKTOP® CONFIGURATOR")

Bye

Hello,

Still don't work. the code is performing but don't close and save, and the loop don't work too. it seems that it has something to do with the "with" statement that after the "end with" it exit and don't run the rest of the code.

 

[Anthony47]

And you don't get any error message?
Try this version:

Sub AllWorkbooksSecond()

   Dim MyFolder As String 'Path collected from the folder picker dialog
   Dim MyFile As String 'Filename obtained by DIR function
   Dim wbk As Workbook 'Used to loop through each workbook
   
   Dim i As Long
   Dim f As Range, c As Range
   Dim message
   
   Sheets("RDS Converter").Select
   Z = Range("I7").Value 'Row range collected from the RDS Converter sheet
   y = Range("I6").Value 'Path collected from the RDS Converter sheet
   PathName = Range("I5").Value 'Path collected from the RDS Converter sheet
   
   
'On Error Resume Next

Application.ScreenUpdating = False
Application.EnableEvents = False

'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False

   If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
      Exit Sub
   End If
   
    MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
Debug.Print ">>>>> TWB is " & ThisWorkbook.Name
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> ""
   'Opens the file and assigns to the wbk variable for future use
   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
   Debug.Print "WBK is " & wbk.Name
   'below is the statements macro to perform
   
   
    
    Debug.Print "A ", MyFile
    With wbk.Sheets("OKTOP® CONFIGURATOR")
        For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
            Debug.Print "B", c.Address(0, 0), c.Value
            If c.Row > Z Then
                MsgBox ("Row " & Z & " Reached")
                GoTo ExitA     'End
            Else
                Set f = Workbooks.Open(PathName & y).Sheets("OKTOP® CONFIGURATOR").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
                Debug.Print "B", y
                If Not f Is Nothing Then
                    f.EntireRow.Copy
                    .Range("A" & c.Row).PasteSpecial xlValues
                    .Range("T" & c.Row).Value = "Yes"
                Else
                    .Range("T" & c.Row).Value = "No"
                End If
            End If
        Next
    End With
    wbk.Close savechanges:=True 'close and save the workbook
    Workbooks(y).Close savechanges:=True
'    f.Close savechanges:=True 'close and save the workbook
    MyFile = Dir 'DIR gets the next file in the folder
    Debug.Print "myFile is " & MyFile
Loop

ExitA:
On Error Resume Next
Debug.Print "WbCount(2) is " & Workbooks.Count
Debug.Print "Wbk(2) is " & wbk.Name
wbk.Close False
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

There are many "debug.print" lines that will record into the "Immediate window" of vba what goes on

When the macro terminates open the macro editor and open the Immediate windows (Contr-g should do the job; or Menu /Display /Immediate window). Copy all what is displayed and insert that log in your next message.
Inspect the log for any confidential information, and hide them using * to replace each character (character by character) that you want to hide

Bye