Change multiple files at once instead of one

Bjerget

New Member
Joined
Sep 27, 2018
Messages
1
I am using this VBA code today

As it works now, I have to choose what file I want to convert every time

I would like it to take all of my * .txt and convert them once
and save them with the same name as before but * .csv

just like now but just all of them at once

The files will be in the same location as the Excel file

Code:
Sub ConvertToCSV()
    Dim filePath: filePath = GetFilePath()
    
    If filePath <> "" Then
        
        Dim sCurrentLine, sTextHead As String, sText2 As String, iSectionLine As Integer
        Dim sText3 As String, sText4 As String, sText5 As String, sText6 As String
        
        Dim objFso As FileSystemObject: Set objFso = New FileSystemObject
        Set txtStream = objFso.OpenTextFile(filePath, ForReading, False)
        
        Dim baseName: baseName = objFso.GetBaseName(objFso.GetFile(filePath))
        
        ' Create a text file.
        Set tsFile = objFso.CreateTextFile(ThisWorkbook.path + "\CSV\" + (baseName) + ".CSV", True)
        
        Do While Not txtStream.AtEndOfStream
            sCurrentLine = txtStream.ReadLine
            
            If txtStream.Line = 4 Then
                sTextHead = sCurrentLine
            End If
            
            If (txtStream.Line > 9) Then
                If Left(sCurrentLine, 10) = "_______NEW" Then
                    iSectionLine = 0
                    
                    For iNumber = iStart To (iStart)
                        tsFile.WriteLine (baseName & ";" & sText2 & ";" & sText3 & ";" & sText4 & ";" & sText5 & ";" & sText6 & ";" & sTextHead & ";")
                    Next
                Else
                    iSectionLine = iSectionLine + 1
                    
                    If iSectionLine = 2 Then
                        sText2 = sCurrentLine
                    End If
                    
                    If iSectionLine = 3 Then
                        sText3 = sCurrentLine
                    End If
                    
                    If iSectionLine = 4 Then
                        sText4 = sCurrentLine
                    End If
                    
                    If iSectionLine = 5 Then
                        sText5 = sCurrentLine
                        End If
                    
                    If iSectionLine = 6 Then
                        sText6 = sCurrentLine
                    End If
                End If
            End If
        Loop
        ' Close data file.
        tsFile.Close
        txtStream.Close
        
        ' Create message.
        sMsg = "Convert to CSV-files:" & vbNewLine & vbNewLine
        sMsg = sMsg & Trim(baseName) + ".CSV"
        
        ' Display message.
        MsgBox sMsg, vbInformation
    End If
End Sub

Function GetFilePath()
    ' Default return value.
    GetFilePath = ""

    ' Define the file dialog.
    Dim fileDialog As Office.fileDialog
    
    ' Create the file dialog.
    Set fd = Application.fileDialog(msoFileDialogFilePicker)
    
    With fd
    
        .AllowMultiSelect = False
        
        ' Set the title of the dialog box.
        .Title = "Please select the TXT-file."
        
        ' Clear out the current filters, and add our own.
        .Filters.Clear
        .Filters.Add "Data Files", "*.TXT"
        .Filters.Add "All Files", "*.*"
        
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        If .Show = True Then
            GetFilePath = .SelectedItems(1) 'replace txtFileName with your textbox
        End If
    End With
End Function
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Forum statistics

Threads
1,224,811
Messages
6,181,081
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top