PDA

View Full Version : Remove double quotes in text (csv) file



emcinco
11-21-2011, 04:44 AM
Hi,

Please help. I am trying to figure out how to remove double quotes that appear in my text file. Original file is taken from excel format. When it goes into a text format double quotes appear around the a text string.

Appreciate your help.

monarchd
11-21-2011, 07:48 AM
Try modifying this code below, ( original from CPearson http://www.cpearson.com/excel/ImpText.aspx )to what you want to do with the Export file contents. I added in some additional If statements for the output I needed.

It wasn't clear exactly what type of data you have in the Excel file and then what type of formatting you wanted in the Output, so hope this gets you going.



Sub FormattedDoTheExport()
Dim filename As Variant
Dim Sep As String
'prompt to ask where and what to call the exported file using Windows built in File Explorer
filename = Application.GetSaveAsFilename(InitialFileName:="myExportedFile-" & _
Format(Date, "mm-dd-yy"), fileFilter:="Text Files (*.txt),*.txt")
If filename = False Then
'user clicked the cancel button, so exit
Exit Sub
End If
' defining the file seperator, which is a comma
Sep = ","
If Sep = vbNullString Then
'seperator not defined, so exit
Exit Sub
End If
Debug.Print "FileName: " & filename, "Separator: " & Sep
' pass in from this sub the actual data to save
ExportToTextFile fname:=CStr(filename), Sep:=CStr(Sep), SelectionOnly:=False, AppendData:=False
' tell the user we've saved the file ok
MsgBox "File Exported.", vbOKOnly, "File Exported."

Exit Sub
End Sub


Public Sub ExportToTextFile(fname As String, Sep As String, SelectionOnly As Boolean, AppendData As Boolean)
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
' suppress screen flicker by turning off the updating of the screen
Application.ScreenUpdating = False
FNum = FreeFile
' export only a selection
If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
' export the entire active worksheet
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If
' to add the data at the bottom of an existing file
If AppendData = True Then
Open fname For Append Access Write As #FNum
Else
' to create a new file overwriting if data exists already in the file
Open fname For Output Access Write As #FNum
End If
For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol

' if blank
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)

' if a number
ElseIf IsNumeric(Cells(RowNdx, ColNdx)) Then
CellValue = Chr(34) & Cells(RowNdx, ColNdx).Text & Chr(34)

' if a date
ElseIf IsDate(Cells(RowNdx, ColNdx)) Then
CellValue = Chr(34) & Cells(RowNdx, ColNdx).Text & Chr(34)

' if it is anything else
Else
CellValue = Chr(34) & Cells(RowNdx, ColNdx).Text & Chr(34)

End If

WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
' turn screen updating back on
Application.ScreenUpdating = True
Close #FNum
End Sub

emcinco
11-27-2011, 12:30 AM
I have a column that contains a description of a spare part.

e.g.
Adapter 1/2" X 1/2" Parker (Purchase Comments:ADAPTER 1/2"x1/2" PARKER

When I convert this into a text file it appears like this:

"Adapter 1/2"" X 1/2"" Parker (Purchase Comments:ADAPTER 1/2""x1/2"" PARKER"

GTO
11-27-2011, 12:54 AM
Are you trying to do this through vba or manually? Are the files currenly in .cvs format?

I would suggest zipping a couple of the text files, along with the wb if you have any current code.

emcinco
11-27-2011, 03:31 AM
Files are currently in excel format. I need convert it to csv so I can migrate the data into a new system. Trouble is double quotes appear in the csv once it is converted in csv.

I haven't attempted working on VBA to solve this. I didn't try manually removing this - I have thousands of records and doing it would be cumbersome.

I read some codes to solve this - but do not know how to incorporate it in the worksheet. I tried the code suggested on the thread but nothing happened.

emcinco
11-27-2011, 03:49 AM
This is sample csv file with double quotes.: pray2:

emcinco
11-27-2011, 04:10 AM
Sample csv with double quotes.

Kenneth Hobs
11-27-2011, 11:32 AM
Option Explicit

Sub ReplaceDoubleQuotes()
Dim f As String, s As String
f = "x:\t\sample.csv"
s = Replace(StrFromTXTFile(f), """""", """")
StrToTXTFile f, s
End Sub

Function StrFromTXTFile(filePath As String) As String
Dim str As String, hFile As Integer

If Dir(filePath) = "" Then
StrFromTXTFile = "NA"
Exit Function
End If

hFile = FreeFile
Open filePath For Binary Access Read As #hFile
str = Input(LOF(hFile), hFile)
Close hFile

StrFromTXTFile = str
End Function

Sub StrToTXTFile(filePath As String, str As String)
Dim hFile As Integer
If Dir(GetFolderName(filePath), vbDirectory) = "" Then
MsgBox filePath, vbCritical, "Missing Folder"
Exit Sub
End If

hFile = FreeFile
Open filePath For Output As #hFile
If str <> "" Then Print #hFile, str
Close hFile
End Sub

Function GetFolderName(Filespec As String) 'Returns path with trailing "\"
'Requires GetFileName() function above
GetFolderName = Left(Filespec, Len(Filespec) - Len(GetFileName(Filespec)))
End Function

Function GetFileName(Filespec As String)
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
GetFileName = FSO.GetFileName(Filespec)
End Function

emcinco
11-27-2011, 08:36 PM
Hi Kenneth,

Apologies, but how do I run the code? Shall I run in excel and save as csv to see the results?

Thanks,

Kenneth Hobs
11-27-2011, 09:18 PM
Copy the code to a Module in VBE. Then modify the value of variable f to point to your csv file. Then run the macro ReplaceDoubleQuotes.

It is a good idea to backup your file before trying a macro.

emcinco
11-28-2011, 02:27 AM
Double quotes are still there in the csv:

I copied the code in excel VBA Module 1;
I ran the code then;
I saved the file in csv - still see the double quotes in csv.

I've attached both excel and csv result.

Kenneth Hobs
11-28-2011, 07:05 AM
This should work.
Sub ReplaceDoubleQuotes()
Dim f As String, s As String, dq As String, sq As String
f = "x:\t\sample.csv"
dq = """"""
sq = """"
'Debug.Print sq, dq
s = StrFromTXTFile(f)
s = Replace(s, dq, sq)
StrToTXTFile f, s
End Sub

emcinco
11-28-2011, 08:34 PM
Not sure if I missed something - quotes still there. I attached a screen shot. :confused:

GTO
11-29-2011, 12:27 AM
Hi All,

I could be off base, but I think that the csv is tacking in the extra quotes around sections that contain commas. In addition, there are quote marks designating inches.

If you are wanting to save it in .txt format, as comma delimited, maybe substitute something for the comma?


Option Explicit

Sub exampleExport()
Dim FSO As Object ' FileSystemObject
Dim TStream As Object ' TextStream
Dim wks As Worksheet
Dim rngLastRowCell As Range
Dim rngLastCellCol As Range
Dim aryVals As Variant
Dim x As Long
Dim y As Long
Dim strText As String

Set wks = ThisWorkbook.Worksheets("Sample")
With wks
Set rngLastCellCol = FindRange(RangeArg:=.Cells, ByColOrRow:=xlByColumns)
If rngLastCellCol Is Nothing Then Exit Sub
Set rngLastRowCell = FindRange(.Cells)

aryVals = .Range(.Cells(1), .Cells(rngLastRowCell.Row, rngLastCellCol.Column))
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
Set TStream = FSO.CreateTextFile(ThisWorkbook.Path & "\Test.txt", True)

For x = 1 To UBound(aryVals, 1)
strText = vbNullString
For y = 1 To UBound(aryVals, 2)
strText = strText & Replace(aryVals(x, y), ",", ";") & ","
Next
TStream.WriteLine Left(strText, Len(strText) - 1)
Debug.Print Left(strText, Len(strText) - 1)
Next
TStream.Close
End Sub

Function FindRange(RangeArg As Range, _
Optional ByVal FindWhat As Variant = "*", _
Optional FindAfter As Range, _
Optional LookWhere As XlFindLookIn = xlValues, _
Optional WholeOrPart As XlLookAt = xlPart, _
Optional ByColOrRow As XlSearchOrder = xlByRows, _
Optional NextOrPrevious As XlSearchDirection = xlPrevious, _
Optional MatchCaseBool As Boolean = False, _
Optional MatchFound As Boolean = False) As Range

If FindAfter Is Nothing Then
Set FindAfter = RangeArg(1, 1)
End If

Set FindRange = RangeArg.Find(What:=FindWhat, _
After:=FindAfter, _
LookIn:=LookWhere, _
LookAt:=WholeOrPart, _
SearchOrder:=ByColOrRow, _
SearchDirection:=NextOrPrevious, _
MatchCase:=MatchCaseBool)
MatchFound = Not FindRange Is Nothing
End Function

emcinco
11-29-2011, 02:05 AM
Hi GTO,

I am trying to save it in .csv, will the same code apply?

GTO
11-29-2011, 03:23 AM
Hi GTO,

I am trying to save it in .csv, will the same code apply?

Did you at least try it?

I would note that I re-looked at the ".csv" at post 7. Forgetting the double-quotes for the moment, why are there all those semi-colons?

Maybe someone can shed some light on this, but as far as I know, a csv is to be comma delimited. If I look at the xls file compared to the csv, it looks like semi-colons are delimiting, which of course don't...

emcinco
11-29-2011, 04:13 AM
The semi-colons are my delimiters. I have set my excel to use this instead of a comma. This is the requirement I have to migrate the data into a new system.

I'm about to try the code.

emcinco
11-29-2011, 04:22 AM
Double quotes were removed. :rotlaugh: My problem now is the separator - - it should be a semi-colon, each line (record) should end with a semi-colon too.

GTO
11-29-2011, 08:39 PM
Changing the last part of the code to:
For x = 1 To UBound(aryVals, 1)
strText = vbNullString
For y = 1 To UBound(aryVals, 2)
'strText = strText & Replace(aryVals(x, y), ",", """,""") & ";"
strText = strText & aryVals(x, y) & ";"

Next
TStream.WriteLine strText ' Left(strText, Len(strText) - 1)
' Debug.Print Left(strText, Len(strText) - 1)

Does that help?

Mark

deankeen
03-26-2014, 04:41 AM
Hey everybody!

Sorry to bring back a very old thread but I'm having this exact problem and am having difficulties getting these VB scripts to run.

When I use Kenneth Hob's script, I get the error: "Run-time error '70': Permission denied". When I debug, it says the problem starts at this line:


Open filePath For Output As #hFile

When I use GTO's script, I get the error: "Run-time error '9': Subscript out of range". When I debug, it says the problem starts at this line:


Set wks = ThisWorkbook.Worksheets("Sample")


Thanks for anyone's help here!
Dan

Kenneth Hobs
03-26-2014, 05:49 AM
Welcome to the forum! Please start your own thread when a thread is old or marked as solved. You can always paste the link or if less than 5 posts, show the thread number, 39895 for this one. When you start your own thread, you can attach a sample text file so that we can test.

If you reply, please do so in your new thread.

I suspect that your folder in filepath has a permission restriction. As for setting the worksheet object, maybe you do not have a sheet name of "Sample" in that workbook?

Paul_Hossler
03-26-2014, 06:08 AM
Set wks = ThisWorkbook.Worksheets("Sample")



Does the workbook with the macro (ThisWorkbook) have a worksheet named "Sample" ?

Paul

Charles_life
02-28-2018, 09:03 AM
Thanks a lot GTO, this solution works great for me! This is saving me hours, I am an happy camper now! Thanks again!

Charles


Hi All,

I could be off base, but I think that the csv is tacking in the extra quotes around sections that contain commas. In addition, there are quote marks designating inches.

If you are wanting to save it in .txt format, as comma delimited, maybe substitute something for the comma?


Option Explicit

Sub exampleExport()
Dim FSO As Object ' FileSystemObject
Dim TStream As Object ' TextStream
Dim wks As Worksheet
Dim rngLastRowCell As Range
Dim rngLastCellCol As Range
Dim aryVals As Variant
Dim x As Long
Dim y As Long
Dim strText As String

Set wks = ThisWorkbook.Worksheets("Sample")
With wks
Set rngLastCellCol = FindRange(RangeArg:=.Cells, ByColOrRow:=xlByColumns)
If rngLastCellCol Is Nothing Then Exit Sub
Set rngLastRowCell = FindRange(.Cells)

aryVals = .Range(.Cells(1), .Cells(rngLastRowCell.Row, rngLastCellCol.Column))
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
Set TStream = FSO.CreateTextFile(ThisWorkbook.Path & "\Test.txt", True)

For x = 1 To UBound(aryVals, 1)
strText = vbNullString
For y = 1 To UBound(aryVals, 2)
strText = strText & Replace(aryVals(x, y), ",", ";") & ","
Next
TStream.WriteLine Left(strText, Len(strText) - 1)
Debug.Print Left(strText, Len(strText) - 1)
Next
TStream.Close
End Sub

Function FindRange(RangeArg As Range, _
Optional ByVal FindWhat As Variant = "*", _
Optional FindAfter As Range, _
Optional LookWhere As XlFindLookIn = xlValues, _
Optional WholeOrPart As XlLookAt = xlPart, _
Optional ByColOrRow As XlSearchOrder = xlByRows, _
Optional NextOrPrevious As XlSearchDirection = xlPrevious, _
Optional MatchCaseBool As Boolean = False, _
Optional MatchFound As Boolean = False) As Range

If FindAfter Is Nothing Then
Set FindAfter = RangeArg(1, 1)
End If

Set FindRange = RangeArg.Find(What:=FindWhat, _
After:=FindAfter, _
LookIn:=LookWhere, _
LookAt:=WholeOrPart, _
SearchOrder:=ByColOrRow, _
SearchDirection:=NextOrPrevious, _
MatchCase:=MatchCaseBool)
MatchFound = Not FindRange Is Nothing
End Function

GTO
03-01-2018, 08:22 AM
Thanks a lot GTO, this solution works great for me! This is saving me hours, I am an happy camper now! Thanks again!

Charles

Greetings Charles,

You are welcome and thank you for the nice feedback. I am afraid that between being busy and lacking Excel on the same PC that I have internet access on, I have become disengaged from answering questions for several months; so it is a real treat to see that some old thread provided help. :cloud9:

I see that you just joined, so let me be the first to say "Welcome to VBAX!". There are a lot of great folks here and I am certain you will be happy you joined.

Have a great day and again, thank you for the feedback,

Mark