Macro for File Management Keeps Adding a Subdirectory!

[redapplesonly]

Hi everyone,

I have a new Macro (written in VBA 7.1) which is supposed to do the following:

• In the same directory as the executing Excel spreadsheet, create a new directory called "SAVED_FILES" (if the directory doesn't already exist)
• For each Tab/Worksheet in the Spreadsheet, perform a "Save As" on the Tab/WS, using the tab's name as the new ___.csv filename. Each CSV file should be placed in "SAVED_FILES". If another file is already in the subdirectory with the same name, that file should be overwritten.

E.g., if I have spreadsheet with TabA, TabB, and TabC, then after the Macro is run, I should see this in my current directory:

   -  MyExcel.xlsx
   -  SAVED_FILES
           - TabA.csv
           - TabB.csv
           - TabC.csv

My code is almost there. The first time it runs, it works perfectly. But then the second time it runs, it does this:

   -  MyExcel.xlsx
   -  SAVED_FILES
           -  SAVED_FILES
                 - TabA.csv
                 - TabB.csv
                 - TabC.csv
           - TabA.csv
           - TabB.csv
           - TabC.csv

That's no good. Each time the Macro runs, adds a new "SAVED_FILES" directory in the previous "SAVED_FILES" directory.

Below is the code of the full Macro. (Apologies for the length!) I'll have some observations below:

Sub SaveWorksheetsAsCSV()
    Dim ws As Worksheet
    Dim currentPath As String
    Dim csvFilename As String
    Dim savedFilesPath As String
    Dim originalWorksheet As Worksheet

    ' Get the current path of the workbook
    currentPath = ThisWorkbook.Path

    ' Create the SAVED_FILES subdirectory if it doesn't exist
    savedFilesPath = currentPath & "\SAVED_FILES"
    If Dir(savedFilesPath, vbDirectory) = "" Then
        MkDir savedFilesPath
    End If

    ' Store the currently active worksheet
    Set originalWorksheet = ActiveSheet

    ' Loop through each worksheet in the workbook
    For Each ws In ThisWorkbook.Worksheets
        ' Activate the worksheet to ensure its contents are saved correctly
        ws.Activate

        ' Set the CSV filename based on the worksheet's name
        csvFilename = savedFilesPath & "\" & ws.Name & ".csv"

        ' Save the worksheet as a CSV file
        ws.SaveAs Filename:=csvFilename, FileFormat:=xlCSV, CreateBackup:=False
    Next ws

    ' Restore the originally active worksheet
    originalWorksheet.Activate

    ' Inform the user that the process is complete
    MsgBox "All worksheets have been saved as CSV files in the SAVED_FILES subdirectory.", vbInformation

End Sub

From debugging, I'm pretty sure the problem is here:

    ' Create the SAVED_FILES subdirectory if it doesn't exist
    savedFilesPath = currentPath & "\SAVED_FILES"

With every iteration of the Macro, the `currentPath` variable seems to be the `savedFilesPath` variable from the previous iteration. This is why a new subdirectory is appended to the string every time.

But why? I thought that when the Macro exits, no variable data is saved. Is there a way to clear this? Or is the problem elsewhere? Thank you.

[Marc L]

I have a new Macro (written in VBA 7.1) which is supposed to do the following

Very not what it does so just removing the bad & the useless and adding the appropriate Excel logic like this VBA demonstration :

Sub Demo1()
    Dim P$, Ws As Worksheet
        P = ThisWorkbook.Path & "\SAVED_FILES\":  If Dir(P, 16) <> "." Then MkDir P
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    For Each Ws In ThisWorkbook.Worksheets
        Ws.Copy
        ActiveWorkbook.SaveAs P & Ws.Name, 6
        ActiveWorkbook.Close
    Next
        .Speech.Speak "Done!", True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub 

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

[redapplesonly]

Yes, this worked perfectly!!! Thank you, this was great! 10,000 Kudos and Karma to you!