Parse Functions‎ > ‎


                                             Sample File:     TxtFilesToCSVs-LimitedRows.xls 
"I have a folder full of text (.txt) files, they are delimited with a pipe character.  I need to convert the entire folder of TXT files into CSV files.  The additional problem is that each file can have no more that 10 rows of data in each CSV file.  They can have less, but not more.  I need a macro to convert all the TXT files into CSV file, splitting each file up as it goes into just 10 rows per file."

  1. The user can designate the path to the text files files
  2. The user can designate the path save the created CSV files
  3. The user can designate what the delimiter is in the current files.  (if left blank, a comma is used by default)
  4. The user can designate how many rows per created CSV file.  Each file is split into that many rows per CSV (if left blank, no parsing is done, files are simply converted)
  5. Saved CSV files are numbered incrementally using the original TXT filename
  6. The macro does not path check, make sure the folders exist and are listed properly on the Control Panel sheet (file attached above)
Using the file attached above, fill in the parameters and run the macro as instructed.   Here is the included code:


Option Explicit
Sub TxtsToCSVs()
'Jerry Beaucaire, 10/16/2012
'Convert a folder of TXT files into CSV files
'Optionally parse the CSV files into set rows per new file
Dim txtPATH As String, csvPATH As String, Delim As String
Dim fNAME As String, RwsPer As Long, Rw As Long, i As Long, fNUM As Long

With ThisWorkbook.Sheets("Control Panel")
    txtPATH = .Range("B2").Text                         'path to TXT files
    If Right(txtPATH, 1) <> Application.PathSeparator Then txtPATH = txtPATH & Application.PathSeparator
    csvPATH = .Range("B3").Text                         'path to save CSV files
    If Right(csvPATH, 1) <> Application.PathSeparator Then csvPATH = csvPATH & Application.PathSeparator
    If Len(.Range("B4")) <> 0 Then Delim = .Range("B4").Text Else Delim = ","
    RwsPer = .Range("B5").Value
End With

On Error Resume Next
fNAME = Dir(txtPATH & "*.txt")                          'get first filename from txtPATH

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Do While Len(fNAME) > 0                                 'process one file at a time
    Workbooks.OpenText txtPATH & fNAME, Origin:=437     'open the file in Excel
    Columns("A:A").TextToColumns Destination:=Range("A1"), _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=True, OtherChar:="|", TrailingMinusNumbers:=True
    fNAME = Replace(fNAME, ".txt", "") & "_"            'shorten filename

    If RwsPer = 0 Then                                  'just convert to CSV and close
        ActiveWorkbook.SaveAs Filename:=fNAME & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    Else                                                'parse to smaller subsets of rows
        fNUM = fNUM + 1                                 'increment filenumber for this filename
        For Rw = 1 To Range("A" & Rows.Count).End(xlUp).Row Step RwsPer
            Rows(Rw).Resize(RwsPer).Copy                'copy set number of rows
            Sheets.Add                                  'create blank sheet
            Range("A1").PasteSpecial                    'paste in copied rows
            ActiveSheet.Move                            'move to separate workbook
                                                        'save as CSV with incremented filenumber
            ActiveWorkbook.SaveAs Filename:=csvPATH & fNAME & fNUM & ".csv", FileFormat:=xlCSV, CreateBackup:=False
            ActiveWorkbook.Close False                  'close created file
            fNUM = fNUM + 1                             'increment for next filenumber
        Next Rw                                         'repeat for next group of rows
        fNUM = 0                                        'reset incrementer for next source file
        ActiveWorkbook.Close False                      'close the sourcefile
    End If
    fNAME = Dir                                         'get next filename

Application.ScreenUpdating = True
End Sub

Nothing says "thanks" like a steak dinner!

PayPal - The safer, easier way to pay online!