Which "apply macro to every file in folder" code is most efficient?

[dguenther]

Hello all,

What is the most efficient way to code a macro to do something to every file in a folder? I've done my homework, and searched the threads. Here are some samplings of code I pulled from those posts

Option Explicit
 
Public Function BrowseForFolder(Optional ByVal StartFolder As Variant)
 
  If IsMissing(StartFolder) Then StartFolder = ""
 
  If StartFolder <> "" Then
    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
  End If
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = StartFolder
    .Title = "Please choose a folder:-"
    .AllowMultiSelect = False
    If .Show = -1 Then BrowseForFolder = .SelectedItems(1)
  End With
 ''''''''''''''''''''''''''''''''''''''''
End Function
'Get the folder object associated with the directory
Dim SelectedFolder As String
SelectedFolder = BrowseForFolder
If SelectedFolder = "" Then
 ' do whatever you need to do when user cancels out of dialog box
  MsgBox "User cancelled!" & Space(10), vbOKOnly + vbExclamation
  Exit Sub
End If
Set objFolder = objFSO.GetFolder(SelectedFolder)

'''''''''''''''''
'Dim xlApp as Excel.Application
If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
    'sets directory and grabs first filename
    sFilename = Dir(sPath & "*.xlsx")
Do Until sFilename = ""
'Code here, to open it I used this...
Set xlApp = New Excel.Application
xlApp.Workbooks.Open (sPath & sFilename)
'More stuff
 xlApp.Quit
 sFilename = Dir
Loop
Set xlApp = Nothing

But what I really need is the most efficient method. There will be 2500 files in this folder. Luckily, I just need to open each txt file, save it as an xls

Workbooks.OpenText Filename:="WHATEVERTHEFILEISCALLED", _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

but I know that even the smallest coding change can greatly improve or hinder efficiency.

What can work for me? Shortest or most efficient code wins!

Thanks,
Dguenther

 

[dguenther]

Oh, I should have also mentioned that it would nice if it could be the type of code where it was like:

codecodecodecode

DO THIS!

codecodecode

where I could just change the DO THIS! to whatever I wanted to do to every file, with the same efficiency concerns.

Thanks!

 

[dguenther]

Anyone?

 

[RSXchin]

This should work.

Private Sub AllFolderFiles()
   Dim wb As Workbook
   Dim TheFile As String
   Dim MyPath As String
   MyPath = GetFolder
   ChDir MyPath
   TheFile = Dir("*.txt")
   On Error Resume Next
   Do While TheFile <> ""
       Application.ScreenUpdating = False
       Set wb = Workbooks.Open(MyPath & "\" & TheFile)
       wb.Activate
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
       wb.Close
       Application.ScreenUpdating = True
       TheFile = Dir
   Loop
   Set wb = Nothing
End Sub
Function GetFolder(Optional strPath As String) As String
   Dim fldr As FileDialog
   Dim sItem As String
   Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
   With fldr
       .Title = "Select a Folder"
       .AllowMultiSelect = False
       .InitialFileName = strPath
       If .Show <> -1 Then GoTo NextCode
       sItem = .SelectedItems(1)
   End With
NextCode:
   GetFolder = sItem
   Set fldr = Nothing
End Function

 

[dguenther]

Thanks rsxchin. One thing- how do i get it to save each new file as the same name of the file it's opening, but of course the saved file will be an xls as opposed to a txt?

Right now, the code opens each file and tries to save it as "The File".

Sub AllFolderFiles()
   Dim wb As Workbook
   Dim TheFile As String
   Dim MyPath As String
   MyPath = GetFolder
   ChDir MyPath
   TheFile = Dir("*.txt")
   On Error Resume Next
   Do While TheFile <> ""
       Application.ScreenUpdating = False
       Set wb = Workbooks.Open(MyPath & "\" & TheFile)
       wb.Activate
ActiveWorkbook.SaveAs Filename:="Filename", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
       wb.Close
       Application.ScreenUpdating = True
       TheFile = Dir
   Loop
   Set wb = Nothing
End Sub
Function GetFolder(Optional strPath As String) As String
   Dim fldr As FileDialog
   Dim sItem As String
   Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
   With fldr
       .Title = "Select a Folder"
       .AllowMultiSelect = False
       .InitialFileName = strPath
       If .Show <> -1 Then GoTo NextCode
       sItem = .SelectedItems(1)
   End With
NextCode:
   GetFolder = sItem
   Set fldr = Nothing
End Function

 

[RSXchin]

when you step through the code, does TheFile ever get assigned a name?

 

[dguenther]

So, I have a folder with 5 txts.
I open a blank sheet and click on the macro. It prompts me to select a folder. It open txt1 and saves it as TheFile.xls. Then it opens the next one and tells me there is already a file with that name, do I want to overwrite it?

One file does end up being created correctly, with the name TheFile.xls.

-Danny

 

[RSXchin]

Sub AllFolderFiles()
   Dim wb As Workbook
   Dim TheFile As String
   Dim MyPath As String
   MyPath = GetFolder
   ChDir MyPath
   TheFile = Dir("*.txt")
   On Error Resume Next
   Do While TheFile <> ""
       Application.ScreenUpdating = False
       Set wb = Workbooks.Open(MyPath & "\" & TheFile)
       wb.Activate
       Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=(Replace(TheFile, ".txt", ".xml"))
       wb.Close
       Application.DisplayAlerts = True
       Application.ScreenUpdating = True
       TheFile = Dir
   Loop
   Set wb = Nothing
End Sub
Function GetFolder(Optional strPath As String) As String
   Dim fldr As FileDialog
   Dim sItem As String
   Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
   With fldr
       .Title = "Select a Folder"
       .AllowMultiSelect = False
       .InitialFileName = strPath
       If .Show <> -1 Then GoTo NextCode
       sItem = .SelectedItems(1)
   End With
NextCode:
   GetFolder = sItem
   Set fldr = Nothing
End Function

this assumes you'll ALWAYS save it as ".xml"

 

[RSXchin]

Did that one do the trick?

 

[dguenther]

Ok, so it kind of worked, but not perfectly:

I need it to use opentext with those parameters, and then save with those parameters. Unfortunately, just inserting those pieces into the code did not run.

Thanks for your help. !filename! is whatever the file's name is...

Sub Macro1()
    Workbooks.OpenText Filename:= _
        "!filename!", _
        Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    
    ActiveWorkbook.SaveAs Filename:= _
        "!filename!", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub