Backup workbooks without formulas in all folder and subfolders via VBA

[navic]

I want to create an archive of all my workbooks that are in the top folder and subfolders in one go (all the information must be presented as a values, therefore no formula).

- Top folder contains multiple subfolders and some workbooks.
- Each subfolder contains multiple sub-subfolders and some workbooks.
- Each sub-subfolder contains multiple Excel workbooks of different formats (xls, xlsx, xlsm). Up to 150 workbooks can be in the sub-subfolder. (see attached image)
- All workbooks *.xlsm format contain VBA macro

I have imagined this in the following way.

After starting the VBA, Excel open each workbook in the top folder, subfolders and sub-subfolders, converts the results obtained from the formulas in text and values and save without formulas in the same file format.

VBA macro can be created by archiving to a different location in a new top folder, named 'Backup Top Folder - Date' (other subfolders, sub-subfolders, and workbooks should have an original name).
Attention! It would be good if it is possible, after starting the VBA macro to appear input popup frame in which I can choose the original top folder as output places where I want to create a backup.

I found the VBA, which archives without the formulas, but the problem is that it works only for one workbook. I want to do this at once for all the workbooks within the top folder, subfolders and sub-subfolders.
In the picture below you can see the simulation of folder organization and workbooks. Folder names, subfolders, sub-folders, and workbooks are simulated.

Anyone here on the forum, who can help me with VBA macro who does what I want?

 

[navic]

Nobody anything
I've searched a lot of web forums and websites in search, but I did not find a similar VBA macro that can save as the values of multiple workbooks in multiple subfolders.

Please, if no one has a similar VBA macro, can anyone give me a links to a tutorials or VBA macro that I can customize to my requirements (I use Excel 2013).

So, the VBA macro needs

a) Loop go through the selected 'top folder', (There is multiple 'subfolder' and multiple 'sub-subfolders' (3 levels))
b) Open each workbook (*.xlsx, *.xlsm)
c) Then, on each worksheet within a workbook run commands, Select all -> Copy -> Paste Special -> Values
d) Save the workbook and close it

Thanks in advance.

 

[Fluff]

For looping through folders & sub folders have a look here http://www.xl-central.com/list-files-folder-subfolders-fso.html

 

[navic]

@Fluff thank you for the link
This is a VBA listing all files from folders and subfolders. I already have a similar one.
I'm going to look any further.

 

[navic]

I found an example of a VBA macro that loops through all the sub folders in the top folder. I also embedded part of the code that opens each workbook and saves it as a values.
But this combination does not work?
Can someone inspect VBA code and correct errors?

'Option Explicit

'top folder countains multiple subfolders
'one folder contains multiple workbooks
'each workbook contains mutiple sheets
'enabled - Microsoft Visual Basic for Applications Extensibility 5.3
'enabled - Microsoft Scripting Runtime

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim wks As Worksheet
Dim fName As String

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

'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 = "*.xlsm*"

'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
''''''''''''''''''''''''''''
    'Insert the actions to be performed on each file
            fName = Dir("*.xlsm*")
        Do While Len(fName) > 0
                With Workbooks.Open(fName)
                'On Error Resume Next
                   For Each wks In .Worksheets
                        wks.UsedRange.Value = wks.UsedRange.Value
                   Next wks
                Application.CutCopyMode = False
                'On Error GoTo 0
                   .Close True
                End With
            fName = Dir
        Loop
'''''''''''''''''''''''''''''''''''''
    '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

 

[navic]

This does not go through all the worksheet and multiple files.
Can anyone correct this part of code?

fName = Dir("*.xlsm*")
Do While Len(fName) > 0
With Workbooks.Open(fName)
'On Error Resume Next
For Each wks In .Worksheets
wks.UsedRange.Value = wks.UsedRange.Value
Next wks
Application.CutCopyMode = False
'On Error GoTo 0
.Close True
End With
fName = Dir
Loop

 

[navic]

There is probably no solution to this problem. I stop tracking this thread.