VBA code to convert .csv to .txt

[CamBF]

Hi guys,

Need urgent help please. We require a VBA code that can be assigned to a macro button that does the following:

1. When pressed brings up a dialog window to select a folder containing all .csv files
2. Code goes through entire folder and converts all .csv files to .txt files
3. Code creates a folder in .csv file location named ".csv files" and moves all .csv files into this folder

Thanks

 

[CamBF]

Hi,

Also need to have the code search each .csv file as it converts it to a .txt file and replace all ";" within the .csv files to ",".

Thanks

 

[HongRu]

Try.

Sub ConvertCSVtoTXT()
    Dim fd As FileDialog
    Dim selectedFolder As String
    Dim csvFolderPath As String
    Dim file As String
    Dim originalFilePath As String
    Dim modifiedContent As String
    Dim fileNumber As Integer
    Dim fs As Object
    
    ' Create a FileDialog object for folder selection
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.Title = "Please select a folder"
    
    ' Select a folder
    If fd.Show = -1 Then
        selectedFolder = fd.SelectedItems(1) ' Get the path of the selected folder
        csvFolderPath = selectedFolder & "\.csv files"
        
        ' Check if the ".csv files" folder exists; if not, create it
        If Dir(csvFolderPath, vbDirectory) = "" Then
            MkDir csvFolderPath ' Create the new folder
        End If
        
        ' Initialize the FileSystemObject
        Set fs = CreateObject("Scripting.FileSystemObject")
        
        ' Search for all .csv files in the selected folder
        file = Dir(selectedFolder & "\*.csv")
        Do While file <> ""
            originalFilePath = selectedFolder & "\" & file
            
            ' Copy .csv files to the ".csv files" folder
            fs.CopyFile Source:=originalFilePath, Destination:=csvFolderPath & "\" & file
            
            ' Open the original .csv file for reading
            fileNumber = FreeFile
            Open originalFilePath For Input As #fileNumber
            modifiedContent = Input$(LOF(fileNumber), fileNumber) ' Read the entire file content
            Close #fileNumber
            
            ' Replace "," with ";"
            modifiedContent = Replace(modifiedContent, ",", ";")
            
            ' Save the modified content back to the original file with .txt extension
            Open Replace(originalFilePath, ".csv", ".txt") For Output As #fileNumber
            Print #fileNumber, modifiedContent
            Close #fileNumber
            
            ' Delete the original .csv file
            Kill originalFilePath
            
            ' Process the next file
            file = Dir
        Loop
        
        MsgBox "All files have been processed!", vbInformation, "Task Complete"
    Else
        MsgBox "No folder was selected.", vbExclamation, "Operation Cancelled"
    End If
    
    ' Clean up resources
    Set fd = Nothing
    Set fs = Nothing
End Sub

 

[CamBF]

Hi HongRu,

I have run the code, it is just about there. See below a couple of things to add / change please:

1. The code doesn't seem to change the ";" characters to "," in the .txt files.

2. There may be instances where the "Layer" column is missed off some of the rows of data (refer to link below for example file, refer to row reading "LEICA_ICON_TOOL"). Where there is no data in the layer column, please have the code insert the text "Unspecified". So for example the row that reads: LEICA_ICON_TOOL;3.377;-9.351;66.987 would then become: LEICA_ICON_TOOL,3.377,-9.351,66.987,Unspecified

If we could have the code do the above two items as well I think that'd be it

Link to example file: Dropbox

Thanks

 

[CamBF]

Hi HongRu,

See below image,might help show what I mean by the Layer value missing in some instances.

 

[HongRu]

Try.

Sub ConvertCSVtoTXT()
    Dim fd As FileDialog
    Dim selectedFolder As String
    Dim csvFolderPath As String
    Dim file As String
    Dim originalFilePath As String
    Dim modifiedContent As String
    Dim fileNumber As Integer
    Dim fs As Object
    
    Dim lines As Variant
    Dim i As Long
    Dim lineParts As Variant
    
    ' Create a FileDialog object for folder selection
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.Title = "Please select a folder"
    
    ' Select a folder
    If fd.Show = -1 Then
        selectedFolder = fd.SelectedItems(1) ' Get the path of the selected folder
        csvFolderPath = selectedFolder & "\.csv files"
        
        ' Check if the ".csv files" folder exists; if not, create it
        If Dir(csvFolderPath, vbDirectory) = "" Then
            MkDir csvFolderPath ' Create the new folder
        End If
        
        ' Initialize the FileSystemObject
        Set fs = CreateObject("Scripting.FileSystemObject")
        
        ' Search for all .csv files in the selected folder
        file = Dir(selectedFolder & "\*.csv")
        Do While file <> ""
            originalFilePath = selectedFolder & "\" & file
            
            ' Copy .csv files to the ".csv files" folder
            fs.CopyFile Source:=originalFilePath, Destination:=csvFolderPath & "\" & file
            
            ' Open the original .csv file for reading
            fileNumber = FreeFile
            Open originalFilePath For Input As #fileNumber
            modifiedContent = Input$(LOF(fileNumber), fileNumber) ' Read the entire file content
            Close #fileNumber
            
            ' Replace ";" with ","
            modifiedContent = Replace(modifiedContent, ";", ",")
            
            lines = Split(modifiedContent, vbCrLf)
    
            ' Check each line
            For i = LBound(lines) To UBound(lines)
                If Trim(lines(i)) <> "" Then ' Make sure the line is not empty
                    lineParts = Split(lines(i), ",")
                    If UBound(lineParts) = 3 Then ' Only 3 commas
                        lines(i) = lines(i) & ",Unspecified"
                    End If
                End If
            Next i
            
            ' Merge the lines
            modifiedContent = Join(lines, vbCrLf)
    
            ' Save the modified content back to the original file with .txt extension
            Open Replace(originalFilePath, ".csv", ".txt") For Output As #fileNumber
            Print #fileNumber, modifiedContent
            Close #fileNumber
            
            ' Delete the original .csv file
            Kill originalFilePath
            
            ' Process the next file
            file = Dir
        Loop
        
        MsgBox "All files have been processed!", vbInformation, "Task Complete"
    Else
        MsgBox "No folder was selected.", vbExclamation, "Operation Cancelled"
    End If
    
    ' Clean up resources
    Set fd = Nothing
    Set fs = Nothing
End Sub

 

[CamBF]

Hi HongRu,

Yes that is perfect, thank you!