CODEWITHSUNDEEP
vbaexcelrename
Operationpbj
Operationpbj

Reputation: 1

Running a Macro over multiple excel files and saving them in a new directory

I know a very similar form of this question has been asked many times before, but I'm having some problems getting it to work with my macro.

Basically, what I need is to have a Macro that will run over several hundred files all located in the same folder, and then "save" the new files (without replacing the old files) in a separate folder/directory. Obviously without having to open each file individually and running the Macro over and over again.

I've tried a few different suggestions but they have all either resulted in drastically unnecessary changes to my fully functioning macro, or have ended in substantial errors.

The location of the original files is--> F:\Reports_Complete\Reports_201308_2014\
. . . The folder only contains files that the Macro needs to run on, and they are all .csv files (the final files should be .xls). . .

The location of the files after the Macro runs should be--> F:\Reports_Complete\

As opposed to copying the entirety of my several hundred line Macro, here are the important lines:

In the beginning of the Macro:

ActiveWorkbook.SaveAs Filename:="F:\Reports_Complete\EXT872_VTDT_" & Range("B2").Text & ".xls"

........................

At the end of the Macro:

With ActiveWorkbook
'MsgBox .FileFormat, , .FullName
Application.DisplayAlerts = False
.SaveAs .FullName, xlNormal
Application.DisplayAlerts = True
'MsgBox .FileFormat, , .FullName
End With

I would be extremely grateful for some help, and if possible without jumping over any steps or procedures ;-)

Thanks again!!!

EDIT

Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook

Pathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.csv")
Do While Filename <> ""
    Set wb = Workbooks.Open(Pathname & Filename)
    DoWork wb
    wb.Close SaveChanges:=True
    Filename = Dir()
Loop
End Sub

..........

Sub DoWork(wb As Workbook)
With wb
'Here is where my code is
End With
End Sub

I've tried using the above code, but it isn't working for me. Is there another way to make my macro work across an entire folder?

Upvotes: 0

Views: 10087

Answers (1)

David Zemens
David Zemens

Reputation: 53623

This is a simple method to loop over the files in a specified folder.

This assumes that your current macro acts on the ActiveWorkbook and already does:

  1. Formats the value in Range("B2")
  2. Saves the file as new file to a specified destination

Try:

Sub LoopFile()
'Enable reference to Microsoft Scripting Runtime if you want to use early binding
    Dim fso as Object  'Scritping.FileSystemObject
    Dim fldr as Object 'Scripting.Folder
    Dim file as Object 'Scripting.File
    Dim wb as Workbook

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = fso.GetFolder("F:\Reports_Complete\Reports_201308_2014\")

    For Each file In fldr.Files
        'Open the file
        Set wb = Workbooks.Open(file.Path)
        '## You will need to modify this line to refer to the correct
        '    module name and macro name:
        Application.Run "Personal.xlsb!Module1.Macro6"

        'Close the file (it was saved in Macro6 already)
        wb.Close
    Next

    Set file = Nothing
    Set fldr = Nothing
    Set fso = Nothing
End Sub

NB I normally do not recommend relying on ActiveWorkbook but I'm not going to sift through hundreds of lines of your code to optimize it. I will recommend that you read THIS on how (and why) to avoid Select and Activate methods.

Upvotes: 1

Related Questions