Macro to open .txt file, delete 2 columns, save as .csv file, and loop to next files

**Agzo** · 2011-07-01, 01:11 PM

I'm not a programmer but I have been working on this for a little but. I need to open the .txt file that is commas delimited. Delete columns A and column I. Save the file as the same name but a .csv. Close the file and open the next one in the same directory and repeat the process. I was worried if I opened them all first excel may crash.

Basically I can get the macro to do what I need it if I list out the file name, but there are thousands of files so I do not want to have to do that.

Here is my example without the loop (because I can not get the loop to successfully work)

Code:

Sub All()
 
Workbooks.OpenText Filename:= _
        "C:\akm\1417.txt" _
        , Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1)), TrailingMinusNumbers:=True
    Range("A:A,I:I").Select
    Range("I1").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveWorkbook.SaveAs Filename:= _
        "C:\akm\1417.csv" _
        , FileFormat:=xlCSV, CreateBackup:=False
    ActiveWindow.Close
 
End Sub

I've been working to try to include something like this, but not being a programmer I'm not sure what i am doing and have not been successful yet.

Code:

dim i as integer
dim maxnum as integer
dim filenamearray() as string
 
for i = 1 to maxnum
          open(  filenamearray(i)  )
next i

Thanks in advance for an advice you may have to get be through this situation.
-Angel

**Ken Puls** · 2011-07-04, 10:46 PM

Hi Agzo, and welcome to the forum!

I've converted your original routine as follows:

Code:

Sub ConvertFileToCSV(sPath As String)
    Dim wbToConvert As Workbook
    Workbooks.OpenText Filename:= _
                  sPath, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                  xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
                   , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
                  Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
                  Array(9, 1)), TrailingMinusNumbers:=True
    Set wbToConvert = ActiveWorkbook
    With wbToConvert
        With .Sheets(1)
            .Columns("I:I").EntireColumn.Delete
            .Columns("A:A").EntireColumn.Delete
        End With
        
        .SaveAs Filename:=WorksheetFunction.Substitute(sPath, ".txt", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
        .Close savechanges:=False
    End With
    
End Sub

That will let you pass the name of the file to the function, open the workbok, remove columns I and A, then save it as a csv. From there we just need to call it, which we can do with a routine like this:

Code:

Sub ConvertEach()
    Dim fso As Object, _
        ShellApp As Object, _
        File As Object, _
        SubFolder As Object, _
        Directory As String, _
        Problem As Boolean
    'Turn off screen flashing
    Application.ScreenUpdating = False
    'Create objects to get a listing of all files in the directory
    Set fso = CreateObject("Scripting.FileSystemObject")
    'Prompt user to select a directory
    Do
        Problem = False
        Set ShellApp = CreateObject("Shell.Application"). _
                       Browseforfolder(0, "Please choose a folder", 0, "c:\\")
        On Error Resume Next
        'Evaluate if directory is valid
        Directory = ShellApp.self.Path
        Set SubFolder = fso.GetFolder(Directory).Files
        If Err.Number <> 0 Then
            If MsgBox("You did not choose a valid directory!" & vbCrLf & _
                      "Would you like to try again?", vbYesNoCancel, _
                      "Directory Required") <> vbYes Then Exit Sub
            Problem = True
        End If
        On Error GoTo 0
    Loop Until Problem = False
    'Look through each file
    For Each File In SubFolder
        If Not Excludes(Right(File.Path, 3)) = True Then
            If Right(LCase(File.Path), 3) = "txt" Then
                Call ConvertFileToCSV(LCase(File.Path))
            End If
        End If
    Next
End Sub

Hope this helps,