Results 1 to 3 of 3

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

  1. #1
    Neophyte Agzo's Avatar
    Join Date
    Jul 2011
    Location
    Florida
    Posts
    2
    Articles
    0

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



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,195
    Articles
    57
    Blog Entries
    14
    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,
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  3. #3
    Neophyte Agzo's Avatar
    Join Date
    Jul 2011
    Location
    Florida
    Posts
    2
    Articles
    0
    Thank you, I think this puts me on the right track!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •