parse csv file

[Shenc]

I have a csv file which needs to be read into a worksheet.
For example, one of the record looks like

2,Apple,"Green, Red"

I use a file object to read the record and parse them to 3 column with some
calculation to get the final result in the worksheet as:

col1 col2 col3
20002 Apple Green,Red

The issue is the double quotation marks which are used when comma is in the
sentence.
Any one has a CSV parse routine to share?

Thanks a lot.

Shen

[Bob Kilmer]

Well formatted CSV files open correctly in Excel. I pasted your sample data
into a blank text file, saved it as temp.csv and opened it in Excel by
double-clicking on the file in Explorer and by using

Workbooks.Open("C:\temp\temp.csv")

from code. It worked flawlessly in both cases. What better parser could you
ask for?

Bob Kilmer

"Shenc" <sh...@hotmail.com> wrote in message
news:O$m1BkGXCHA.2520@tkmsftngp09...

[Shenc]

Becasue I have 300+ files to process I don't want to open so many workbooks.
I also want to learn VBA.

Thanks.

"Bob Kilmer" <rpr...@yahoo.com> wrote in message
news:O06QnSHXCHA.3736@tkmsftngp08...

[Dave Peterson]

Take a look at Chip Pearson's text importer code at:
http://www.cpearson.com/excel/imptext.htm

You'll learn a lot (including when to use xl's parser! <vbg>).

Also, take a look at application.filesearch (to get the list of 300 files) in
help.

--

Dave Peterson
ec3...@msn.com

[Bob Kilmer]

Maybe you want to read 300+ files using VBA, and that is fine if you do,
although 'copy *.csv every.csv2' at the command line or via Shell() in VBA
will copy every csv in the current directory (a.k.a., folder) to the single
file every.csv2. This would be suitable if concatenating them makes sense.
Rename every.csv2 to every.csv after the copy so the system will know it as
a csv file. You can also specify the full path of the source and target so
the command is independent of the current directory.

'type *.csv >> every.csv' works, too.

This appends each successive file to every.csv.
type 1.csv >> every.csv
type 2.csv >> every.csv
type 3.csv >> every.csv
etc.

Happy coding.

"Shenc" <sh...@hotmail.com> wrote in message

news:#1xs3PIXCHA.2372@tkmsftngp12...

[Shenc]

Thanks,

But the code on the webpage breaks when there is a comma in the sentence,

Shen

"Dave Peterson" <ec3...@msn.com> wrote in message
news:3D848B94...@msn.com...

[Bob Kilmer]

So, do you want to remove the comma in 'Green,Red'? Or remove the quotation
marks in 2,Apple,"Green, Red" before you parse on the comma? You can do some
variation on Search-and-Replace to replace unwanted characters with a null
string.

"Shenc" <sh...@hotmail.com> wrote in message

news:#wHrD1OXCHA.2540@tkmsftngp09...

[Tom Ogilvy]

Here is a modification of Chip's code that works with the data you showed:

Public Sub DoTheImport()
Dim FName As Variant
Dim Sep As String

FName = Application.GetOpenFilename _
(filefilter:= _
"Text Files(*.txt),*.txt,All Files (*.*),*.*")
If FName = False Then
MsgBox "You didn't select a file"
Exit Sub
End If

Sep = InputBox("Enter a single delimiter character.", _
"Import Text File")
ImportTextFile CStr(FName), Sep

End Sub

Public Sub ImportTextFile(FName As String, Sep As String)

Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Open FName For Input Access Read As #1

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
If Left(WholeLine, 1) = Chr(34) Then
NextPos = InStr(Pos, _
WholeLine, Chr(34) & Sep) + 1
Else
NextPos = InStr(Pos, WholeLine, Sep)
End If
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
If Left(TempVal, 1) = Chr(34) Then _
TempVal = Right(TempVal, Len(TempVal) - 1)
If Right(TempVal, 1) = Chr(34) Then _
TempVal = Left(TempVal, Len(TempVal) - 1)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
If Mid(WholeLine, Pos, 1) = Chr(34) Then
NextPos = InStr(Pos, WholeLine, _
Chr(34) & Sep) + 1
Else
NextPos = InStr(Pos, WholeLine, Sep)
End If
Wend
RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub

Regards,
Tom Ogilvy

Shenc <sh...@hotmail.com> wrote in message

news:#wHrD1OXCHA.2540@tkmsftngp09...

[Shenc]

Thanks, that's exactly what I wanted.

I'd like to also thank all the people who replied to my questions. I learnt
a lot from you guys.

Shen

"Tom Ogilvy" <twog...@msn.com> wrote in message
news:O$JTNWPXCHA.2520@tkmsftngp09...

[Tetsuo Mori]

Shen,

Please try the below steps.

Step1: Make a folder.
Step2: Save your 300+ files into the folder.
Step3: Run my Test macro and select the folder.

I hope the macro is helpful.

Thanks,

Tetsuo Mori

---------------------------------------------------------------------
Option Explicit

Public Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Public Const C_RF_DESKTOP = &H0
Public Const BIF_BROWSEFORCOMPUTER = 1
Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBROWSEINFO As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
Public Declare Function CoTaskMemFree Lib "OLE32.dll" _
(ByVal pv As Long) As Long

Function ComdlgGetFolderStr(msgStr As String) As String
Dim typBROWSEINFO As BROWSEINFO
Dim lngFoldPointer As Long
Dim strPathName As String
Dim m As Long
Dim n As Long
Dim tmp As String

ComdlgGetFolderStr = ""

With typBROWSEINFO
.hwndOwner = FindWindow("XLMAIN", 0)
.pidlRoot = C_RF_DESKTOP
.lpszTitle = msgStr
.ulFlags = BIF_BROWSEFORCOMPUTER
End With

lngFoldPointer = SHBrowseForFolder(typBROWSEINFO)

strPathName = String$(128, vbNullChar)
SHGetPathFromIDList lngFoldPointer, strPathName

If Left(strPathName, 1) <> vbNullChar Then
m = Len(strPathName)

For n = m To 1 Step -1
If Asc(Mid(strPathName, n, 1)) <> 0 Then Exit For
Next n
strPathName = Mid(strPathName, 1, n)
ComdlgGetFolderStr = CStr(strPathName)
End If

Call CoTaskMemFree(lngFoldPointer)
End Function

Sub Test()
Dim myFolder As String
Dim myCVSFiles As FileSearch
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim myLastRow1 As Long
Dim myLastRow2 As Long
Dim myLastColumn As Long

myFolder = ComdlgGetFolderStr("Please select a folder.")

If myFolder = "" Then
Exit Sub
End If

Set myCVSFiles = Application.FileSearch

With myCVSFiles
.LookIn = myFolder
.SearchSubFolders = True
.Filename = "*.csv"

If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.OpenText Filename:=.FoundFiles(i), _
DataType:=xlDelimited
myLastRow1 = ActiveSheet.Cells(1, 1). _
CurrentRegion.Rows.Count
myLastColumn = ActiveSheet.Cells(1, 1). _
CurrentRegion.Columns.Count
For j = 1 To myLastRow1
For k = 1 To myLastColumn
With ThisWorkbook.Worksheets("sheet1")
.Cells(myLastRow2 + j, 1) = _
myCVSFiles.FoundFiles(i)
.Cells(myLastRow2 + j, k + 1) = _
ActiveSheet.Cells(j, k)
End With
Next k
Next j
myLastRow2 = ThisWorkbook.Worksheets("sheet1"). _
Cells(1, 1).CurrentRegion.Rows.Count
ActiveWindow.Close
Next i
End If
End With
End Sub
---------------------------------------------------------------------