VBA Open File/Run Code/Close & Save/Open Next File

[tripleblack811]

Goodafternoon,


Wehave had a lot of threads over the years for a macro that :

1. Goes into a specific folder
   
2. Opens a file in that folder
   
3. Performs some code in that file
   
4. Saves the file
   
5. Closes the file
   
6. Repeats 1-5 for each file in that folder

I have trawled through this site as best I can (https://www.mrexcel.com/forum/excel...-file-run-code-close-save-open-next-file.html), and the problems I am having are:

VBA performs the procedure on all the files without closingthem after they have finished:
e.g

[FONT=Calibri][SIZE=3][COLOR=#000000]Sub ForEACh[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]        Dim FSO, Myfolder, Myfile[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]        Set FSO =CreateObject("Scripting.FileSystemObject")[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]        Set Myfolder =FSO.GetFolder("Z:\Audit Archive")[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]        For Each Myfile In Myfolder.Files[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]                [Insert procedure][/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]        Next[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]

Or:

[FONT=Calibri][SIZE=3][COLOR=#000000]SubAllFiles()[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    Dim folderPath As String[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    Dim filename As String[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    Dim wb As Workbook[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]  [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    folderPath = "Q:\Test" 'change tosuit[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    If Right(folderPath, 1) <>"\" Then folderPath = folderPath + "\"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    filename = Dir(folderPath &"*.xls")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    Do While filename <> ""[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]      Application.ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]        Set wb = Workbooks.Open(folderPath& filename)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000][Insert procedure][/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    Loop[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]  Application.ScreenUpdating = True[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]

I have triedusing the following to save and close the file:

[FONT=Calibri][SIZE=3][COLOR=#000000]Workbooks(folderPath& filename).Close Savechanges:=True[/COLOR][/SIZE][/FONT]

It did notwork!

May I ask:

1. Why it didn’t work?
   
2. How I can make it work?

Any helpwould be hugely appreciated.

Jim

 

[Fluff]

Try

Sub AllFiles()

    Dim folderPath As String
    Dim Fname As String
    Dim wb As Workbook

    folderPath = "Q:\Test" 'change tosuit

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

    Fname = Dir(folderPath & "*.xls")
    Do While Fname <> ""
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(folderPath & Fname)
         '[Insert procedure]
         wb.Close True
         Fname = Dir()
    Loop
  Application.ScreenUpdating = True
End Sub

 

[tripleblack811]

Try

Sub AllFiles()

    Dim folderPath As String
    Dim Fname As String
    Dim wb As Workbook

    folderPath = "Q:\Test" 'change tosuit

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

    Fname = Dir(folderPath & "*.xls")
    Do While Fname <> ""
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(folderPath & Fname)
         '[Insert procedure]
         wb.Close True
         Fname = Dir()
    Loop
  Application.ScreenUpdating = True
End Sub

Thank you very much, really appreciate it.

Is there a way to rewrite:

        Set wb = Workbooks.Open(folderPath & Fname)

To something that turns off UpdateLinks, eg.:

        Workbooks.Open filename:=Myfile, UpdateLinks:=0

 

[Fluff]

Try

        Set wb = Workbooks.Open(folderPath & Fname, False)