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]

Very close, but not there yet. When I press the other command button I get an error "Run time error 52 - Bad file name or number".

It points to:

 While Not EOF(3)
            Line Input #3, sdata
            If Len(sdata) > 18 Then
                res = res & Chr(9) & sdata
            End If

 

[diddi]

its getting a bit late here (1.20am) getting a bit dull in the head

 While Not EOF(1)         '  <-----
            Line Input #1, sdata         '  <-----
            If Len(sdata) > 18 Then
                res = res & Chr(9) & sdata
            End If

 

[neobavesten]

Next one is "run time error 54" Bad file mode. Directs to:

    Print #1, res

 

[diddi]

print #2, res

 

[neobavesten]

Now I get: Run time error 53-File not found". It directs to:

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

 

[diddi]

could you post the whole sub pls. also check c:\ to see if the output file contains any data yet

 

[neobavesten]

Here is the code. There are no CSV files on C:\
Many thanks for your support Diddi!!!

Private Sub UserForm_Click()
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
    Next row
    Close
End Sub

 

[diddi]

dump this line:

Private Sub UserForm_Click()


it is stopping your shared variables from being shared

 

[neobavesten]

Now I get this Run time error - file already open.
Points to:

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

 

[diddi]

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