Hi guys,
Need help making changes to a code I have had previously put together for me.
The code below splits a .txt file into multiple .csv files and archives the original .txt file into a folder.
I need it to also replace all the "," characters in the .csv files it generates with ";".
Thanks
Need help making changes to a code I have had previously put together for me.
The code below splits a .txt file into multiple .csv files and archives the original .txt file into a folder.
I need it to also replace all the "," characters in the .csv files it generates with ";".
Thanks
VBA Code:
Sub GroupAndExportCsv()
Dim csvFile As String
Dim outputDir As String
Dim supercededDir As String
Dim delimiter As String
Dim line As String
Dim header As Variant
Dim FSO As Object
Dim fileStream As Object
Dim outputStream As Object
Dim data As Variant
Dim groups As Object
Dim groupName As Variant
Dim i As Integer
Dim isFirstLine As Boolean
Dim fd As FileDialog
Dim filePath As String
' Open file dialog to select the CSV file
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select CSV File"
.Filters.Add "CSV Files", "*.txt", 1
.AllowMultiSelect = False
If .Show = -1 Then
csvFile = .SelectedItems(1)
Else
MsgBox "No file selected. Exiting..."
Exit Sub
End If
End With
' Set parameters
delimiter = ","
outputDir = fd.InitialFileName
supercededDir = outputDir & "_superceded\"
' Set header
header = Array("ID", "X(m)", "Y(m)", "Z(m)", "Layer")
' Create FileSystemObject and Dictionary objects
Set FSO = CreateObject("Scripting.FileSystemObject")
Set groups = CreateObject("Scripting.Dictionary")
' If outputDir does not exist, create it
If Not FSO.FolderExists(outputDir) Then
FSO.CreateFolder (outputDir)
End If
' If supercededDir does not exist, create it
If Not FSO.FolderExists(supercededDir) Then
FSO.CreateFolder (supercededDir)
End If
' Open the original CSV file
Set fileStream = FSO.OpenTextFile(csvFile, 1, False)
' Initialize as the first line
isFirstLine = True
' Read file line data and group by the 5th column
Do While Not fileStream.AtEndOfStream
line = fileStream.ReadLine
' Check if it is the first line
If isFirstLine Then
isFirstLine = False
Else
data = Split(line, delimiter)
groupName = Replace(data(4), " ", "") ' Group by the 5th column
If Not groups.Exists(groupName) Then
groups.Add groupName, New Collection
End If
' Remove spaces from each element and join only the first 5 columns
groups(groupName).Add Join(Array(Replace(data(0), " ", ""), Replace(data(1), " ", ""), Replace(data(2), " ", ""), Replace(data(3), " ", ""), Replace(data(4), " ", "")), delimiter)
End If
Loop
' Close the original CSV file
fileStream.Close
' Write each group data to different CSV files
For Each groupName In groups.Keys
Set outputStream = FSO.CreateTextFile(outputDir & groupName & ".csv", True, False)
' Write header
outputStream.WriteLine Join(header, delimiter)
' Write data
For i = 1 To groups(groupName).Count
outputStream.WriteLine groups(groupName).Item(i)
Next i
outputStream.Close
Next groupName
' Move the original .txt file to the _superceded directory
FSO.MoveFile csvFile, supercededDir & FSO.GetFileName(csvFile)
' Cleanup
Set fileStream = Nothing
Set outputStream = Nothing
Set groups = Nothing
Set FSO = Nothing
End Sub
