Macro to convert TXT to CSV files

[neobavesten]

Hi,

I have a bulk of TXT files organized in same format. Is the a way to write a macro that could convert those text files to *csv files?

Text file contains multiple sentences. I would like to keep that text as one block in CSV file.

I would really appreciate if someone could help me with this.
Many thanks!

 

[neobavesten]

Run time error 55 - File already open.

Points to

 Open SelFolder & ListBox1.List(row) For Input As #1

 

[diddi]

did you add the close #1 line in

 

[neobavesten]

yes I did

 

[diddi]

are you running from 'break' if so stop execution and start again

 

[neobavesten]

No I am not. I just reopened the whole workbook. error appears again. Hm..

 

[diddi]

could you post all the code again

 

[neobavesten]

here is the code:

Dim sFiles() As String, row As Long, SelFolder As String

Private Sub CommandButton2_Click()
    DoConvert
End Sub
Sub userform_initialize()
    CommandButton2.Visible = False
End Sub

Private Sub CommandButton1_Click()
    GetFolder
End Sub

Sub GetFolder()
    ListBox1.Clear
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select your folder of text files"
        .ButtonName = "Open"
        .Show
        SelFolder = .SelectedItems.Item(1) & "\"
    End With
    
    sFiles = AllFiles(SelFolder)

    For row = 0 To UBound(sFiles)
         If Right(sFiles(row), 4) = ".txt" Then
            ListBox1.AddItem sFiles(row)
        End If
    Next row
    Select Case ListBox1.ListCount
        Case 0
            Label1.Caption = "Didnt find any files - choose another folder"
            CommandButton2.Visible = False
        Case Is > 1
            Label1.Caption = "Found these " & ListBox1.ListCount & " files..."
            CommandButton2.Visible = True
        Case 1
            Label1.Caption = "Found just this 1 file..."
            CommandButton2.Visible = True
    End Select
End Sub

Function AllFiles(ByVal FullPath As String) As String()
    Dim oFs As New FileSystemObject
    Dim sAns() As String
    Dim oFolder As Folder
    Dim oFile As File
    Dim lElement As Long
    
    Label1.Caption = "Searching for files..."
    DoEvents
    Application.Cursor = xlWait
    ReDim sAns(0) As String
    If oFs.FolderExists(FullPath) Then
        Set oFolder = oFs.GetFolder(FullPath)
     
        For Each oFile In oFolder.Files
          lElement = IIf(sAns(0) = "", 0, lElement + 1)
          ReDim Preserve sAns(lElement) As String
          sAns(lElement) = oFile.Name
        Next
    End If

    AllFiles = sAns
    Application.Cursor = xlDefault
    
ErrHandler:
    Set oFs = Nothing
    Set oFolder = Nothing
    Set oFile = Nothing
End Function


Sub DoConvert()
    Application.Cursor = xlWait
    Open SelFolder & "Combined Files.txt" For Output As #2
    For row = 0 To ListBox1.ListCount - 1
        Open SelFolder & ListBox1.List(row) For Input As #1
        res = ""
        While Not EOF(1)
            Line Input #1, sdata
            If Len(sdata) > 18 Then
                res = res & Chr(9) & sdata
            End If
        Wend
        Print #2, res
  Close #1
    Next row
    Close
End Sub

 

[diddi]

its working for me!

Sub DoConvert()
    Application.Cursor = xlWait
    Open "C:\Combined Files.txt" For Output As #2
    For row = 0 To ListBox1.ListCount - 1
        Open SelFolder & ListBox1.List(row) For Input As #1
        res = ""
        While Not EOF(1)
            Line Input #1, sdata
            If Len(sdata) > 18 Then
                res = res & Chr(9) & sdata
            End If
        Wend
        Print #2, res
        Close #1
    Next row
    Close
    Application.Cursor = xlDefault
End Sub

 

[neobavesten]

Diddi...you are awesome!!! Many thanks! It works here as well.

However, combined file is not CSV and is not formatted in a way it should be (I explained in the first post). Is there anyway to correct this?

 

[diddi]

                res = res & "," & sdata

i did tab delimited