VBA Replace last field in ALL rows within csv around double quotes? - vba

Question

On Error Resume Next
Set FileSysObj = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1 ' Declare constant for reading for more clarity
Dim cntFile, strCSVFullFile, strCSVFile, strDIR, cntBadLines, cntAllLines, strArchiveDir, strSafeTime,strSafeDate
' -------------------------------------------------------------------------------------------
' Specify CSV file name from the input argument
strCSVFile = Wscript.Arguments(1) ' Transactions
strDIR = Wscript.Arguments(2) & "\" ' C:\Temp
strArchiveDir = Wscript.Arguments(3) & "\"
strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
strSafeDate = Year(Date) & Month(Date) & day(Date)
set folder = FileSysObj.getFolder(strDIR)
cntFile = 0
cntBadLines = 0
cntAllLines = 0
for each file in folder.Files
' check if the file is there and echo it.
if InStr(1,file.name,strCSVFile,1) <> 0 then
strCSVFullFile = file.name
cntFile = cntFile + 1
end if
next
if cntFile > 1 or cntFile = 0 then
' error and end
Wscript.Echo "Error - only 1 file required for this process. There are " & cntFile & " file(s) in the directory"
WScript.Quit
end if
wscript.echo "Checking the file " & strCSVFullFile & " in " & strDIR
NoOfCols = Wscript.Arguments(0) ' usually 8
strTemp = "temp.csv"
strmissing = "missingdata.csv"
Set objOutFile = FileSysObj.CreateTextFile(strDIR & strTemp,True)
Set objOutFileM = FileSysObj.CreateTextFile(strDIR & strmissing,True)
Set inputFile = FileSysObj.OpenTextFile(strDIR & strCSVFullFile, ForReading, True)
' Set inputFile as file to be read from
Dim row, column, outline
Dim fields '(7) '8 fields per line
inputFile.ReadAll 'read to end of file
outline = ""
ReDim MyArray(inputFile.Line-2,NoOfCols) 'current line, minus one for header, and minus one for starting at zero
inputFile.close 'close file so that MyArray can be filled with data starting at the top
Set inputFile = FileSysObj.OpenTextFile(strDIR & strCSVFullFile, ForReading, True) 'back at top
strheadLine = inputFile.ReadLine 'skip header , but keep it for the output file
objOutFile.Write(strheadLine & vbCrLf)
anyBadlines = False
badlineflag = False
Do Until inputFile.AtEndOfStream
fullLine = inputFile.Readline
fields = Split(fullLine,",") 'store line in temp array
For column = 0 To NoOfCols-1 'iterate through the fields of the temp array
myArray(row,column) = fields(column) 'store each field in the 2D array with the given coordinates
'Wscript.Echo myArray(row,column)
if myArray(row,0) = " " or myArray(row,1) = " " then
badlineflag = True
'missline = myArray(row,0) & ", " & myArray(row,1) & ", " & myArray(row,2) & ", " & myArray(row,3) & ", " & myArray(row,4) & ", " & myArray(row,5) & ", " & myArray(row,6) & ", " & myArray(row,7)
'Wscript.Echo missline
'Exit For
end if
if column = NoOfCols-1 then
outline = outline & myArray(row,column) & vbCrLf
else
outline = outline & myArray(row,column) & ","
'csvFile = Regex.Replace(csvFile, "(,\s*?"".*?)(,)(\s+.*?""\s*?,)", "$1$3") 'TEST
end if
Next
cntAllLines = cntAllLines + 1
' Wscript.Echo outline
if badlineflag = False then
objOutFile.Write(fullLine & vbCrLf)
else
' write it somewhere else, drop a header in the first time
if anyBadlines = False Then
objOutFileM.Write(strheadLine & vbCrLf)
End if
objOutFileM.Write(outline)
cntBadLines = cntBadLines + 1
badlineflag = False
anyBadlines = True
end if
outline = ""
row = row + 1 'next line
Loop
objOutFile.Close
objOutFileM.Close
inputFile.close
Wscript.Echo "Total lines in the transaction file = " & cntAllLines
Wscript.Echo "Total bad lines in the file = " & cntBadLines
The below line is able to work as it contains 7 commas (8 columns).
URXW_99,BYQ0JC6,2603834418,2017-10-30,Test,4.962644,2278.0000,ABC
The below line will throw an error as a result of more commas than 7 in the script.
URXW_99,BYQ0JC6,2603834418,2017-10-30,Test,4.962644,2278.0000,Redburn, Europe. Limited
If greater than 7 commas in the CSV file line, the aim is to wrap it all greater than 7 into one field.
E.g. how do you replace Redburn, Europe. Limited string with double quotes as it is one name.
For example, in a text file it would appear like below:
URXW_99,BYQ0JC6,2603834418,2017-10-30,Test,4.962644,2278.0000,"Redburn, Europe. Limited"
Is there a way to write a VB or VBA script to do the above and save it as a .csv file (which is opened via notepad to check the double quotes)?
Option Explicit
Option Compare Text
Public Sub ConvertFile()
Dim lngRowNumber As Long
Dim strLineFromFile As String
Dim strSourceFile As String
Dim strDestinationFile As String
strSourceFile = "U:\Book3.csv"
strDestinationFile = "U:\Book4.csv"
Open strSourceFile For Input As #1
Open strDestinationFile For Output As #2
lngRowNumber = 0
Do Until EOF(1)
Line Input #1, strLineFromFile
strLineFromFile = Right(Replace(strLineFromFile, ",", " ", 1), 1000)
Write #2, strLineFromFile
strLineFromFile = vbNullString
Loop
Close #1
Close #2
End Sub

Answer 1

As I see, you use MS Access (due to Option Compare Text line), so there is better built-in instruments for this task.
Use DoCmd.TransferText for it.
1st step is to create output specification via:
Here you can setup delimiters, even that differs from ", and handle other options.
After that you can use your set-up specification via following command
DoCmd.TransferText acExportDelim, "TblCustomers_export_spec", "TblCustomers", "C:\test\1.txt", True
In this case all characters escaping would be done through built-in instruments. It seems to be more easier to correct this code further.
As mentioned, there is VBScript workaround. For given input data, following function will do desired actions for given string:
Option Explicit
Function funAddLastQuotes( _
strInput _
)
Dim arrInput
arrInput = Split(strInput, ",")
Dim intArrSize
intArrSize = UBound(arrInput)
Dim intCurrentElement
Dim strOutput
Dim intPreLastElement
intPreLastElement = 6
For intCurrentElement = 1 To intPreLastElement
strOutput = strOutput & "," & arrInput(intCurrentElement)
Next
Dim strOutputLastField
For intCurrentElement = intPreLastElement + 1 To intArrSize
strOutputLastField = strOutputLastField & "," & arrInput(intCurrentElement)
Next
strOutputLastField = Right(strOutputLastField, Len(strOutputLastField) - 1)
strOutput = Right(strOutput, Len(strOutput) - 1)
strOutput = strOutput & "," & """" & strOutputLastField & """"
funAddLastQuotes = strOutput
End Function
MsgBox funAddLastQuotes("RXW_99,BYQ0JC6,2603834418,2017-10-30,Test,4.962644,2278.0000,Redburn, Europe,,, Limited")

Answer 2

Finally, here is working VBScript solution.
Option Explicit
Const ColumnsBeforeCommadColumn = 6
Function funAddLastQuotes( _
strInput _
)
Dim arrInput
arrInput = Split(strInput, ",")
Dim intArrSize
intArrSize = UBound(arrInput)
Dim intCurrentElement
Dim strOutput
Dim intPreLastElement
intPreLastElement = ColumnsBeforeCommadColumn
For intCurrentElement = 1 To intPreLastElement
strOutput = strOutput & "," & arrInput(intCurrentElement)
Next
Dim strOutputLastField
If (intPreLastElement + 1) < intArrSize _
Then
For intCurrentElement = intPreLastElement + 1 To intArrSize
strOutputLastField = strOutputLastField & "," & arrInput(intCurrentElement)
Next
Else
strOutputLastField = strOutputLastField & "," & arrInput(intArrSize)
End If
strOutputLastField = Right(strOutputLastField, Len(strOutputLastField) - 1)
strOutput = Right(strOutput, Len(strOutput) - 1)
strOutput = strOutput & "," & """" & strOutputLastField & """"
funAddLastQuotes = strOutput
End Function
Public Sub ConvertFile( _
strSourceFile _
)
Dim objFS
Dim strFile
Dim strTemp
Dim ts
Dim objOutFile
Dim objFile
Set objFS = CreateObject("Scripting.FileSystemObject")
Dim strLine
Dim strOutput
Dim strRow
strFile = strSourceFile
strTemp = strSourceFile & ".tmp"
Set objFile = objFS.GetFile(strFile)
Set objOutFile = objFS.CreateTextFile(strTemp,True)
Set ts = objFile.OpenAsTextStream(1,-2)
Do Until ts.AtEndOfStream
strLine = ts.ReadLine
objOutFile.WriteLine funAddLastQuotes(strLine)
Loop
objOutFile.Close
ts.Close
objFS.DeleteFile(strFile)
objFS.MoveFile strTemp,strFile
End Sub
ConvertFile "C:\!accsoft\_in.csv"
You should change following part: ConvertFile "C:\!accsoft\_in.csv as path to your file.
And ColumnsBeforeCommadColumn = 6 is the setting, at which column the chaos with commas begins