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
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Watch MrExcel Video

Forum statistics

Threads
1,108,621
Messages
5,523,947
Members
409,543
Latest member
LaMaqu1na

This Week's Hot Topics

Top