Solved

How do you split by two delimiters?

Posted on 2009-05-11
12
875 Views
Last Modified: 2012-06-27
I need to know how to split by two delimiters. As you can see, my CSV has commas and quote+comma and my code below doesn't load the info into the MSFlexGrid properly. Here is the CSV info (notice how it is delimited)


Private Sub mnuLoadCSV_Click()

Dim strRecord As String

Dim sTokens() As String

Dim x As Integer

Dim sTemp As String

Dim strRow As String

 

 

 

On Error Resume Next

Dim FileName As String

With CommonDialog1

    .FileName = ""

    .InitDir = App.Path & "\lists"

    .Filter = "CSV Files (*.csv)|*.csv"

    .ShowOpen

    FileName = .FileName

End With

If Len(FileName) Then

 

Open FileName For Input As #1

Do While Not EOF(1)

   Line Input #1, strRecord

         'strRecord = Replace(strRecord, """", "")

         sTokens = Split(strRecord, ",")

         MSFlexGrid.cols = UBound(sTokens)

         MSFlexGrid.AddItem sTokens(0) & vbTab & sTokens(1) & vbTab & sTokens(2) _

                                    & vbTab & sTokens(4) & vbTab & sTokens(5) & vbTab & sTokens(6) _

                                    & vbTab & sTokens(7) & vbTab & sTokens(8) & vbTab & sTokens(9) _

                                    & vbTab & sTokens(10) & vbTab & sTokens(11) & vbTab & sTokens(12) _

                                    & vbTab & sTokens(13)

                                   

Loop

Close #1

End If

End Sub
 
 
 
 
 
 
 
 

Date,Time,Venue,Address,City,State,Postal Code,Country,Details,Age Limit,Private,Ticket Details,Ticket Link,Artists

05/07/2009,9:00 PM,"Paddy ONeills @ Historic Alex Johnson Hotel","523 Sixth Street","Rapid City",SD,"57701",US,"","21+",,"Free","",""

05/08/2009,9:00 PM,"Paddy ONeills @ Historic Alex Johnson Hotel","523 Sixth Street","Rapid City",SD,"57701",US,"","21+",,"Free","",""

05/09/2009,9:00 PM,"Paddy ONeills @ Historic Alex Johnson Hotel","523 Sixth Street","Rapid City",SD,"57701",US,"","21+",,"Free","",""

05/16/2009,4:30 PM,"U District Street Fair","47th Street Stage","Seattle",WA,"98105",US,"","All Ages",,"Free","",""

06/06/2009,9:30 PM,"Lucia Italian Restaurant & Bar","222 Park Place Center","Kirkland",WA,"98033",US,"","All Ages",,"Free","",""

06/06/2009,11:00 AM,"Tastin and Racin Festival","Lake Sammamish State Park, 2000 NW Sammamish Road","Issaquah",WA,"98027",US,"","",,"","",""

06/12/2009,3:00 PM,"Bothell Farmers Market","23718 Bothell Everett Hwy, Bothell, WA","Bothell",WA,"98011",US,"","",,"","",""

06/18/2009,7:00 PM,"Firehouse Pub","780 Main Street","Buckley",WA,"98321",US,"","",,"","",""

06/19/2009,8:00 PM,"Red Dog Saloon","18608 Renton Maple Valley RD SE","Maple Valley",WA,"98038",US,"","",,"","",""

06/20/2009,12:00 PM,"Kent Farmers Market","4th Ave N At W Smith St Kent","Kent",WA,"98032",US,"","",,"","",""

Open in new window

0
Comment
Question by:Taylor814
  • 4
  • 2
  • 2
  • +3
12 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 24357988
The simplest way would be to load the CSV file into an application that understands the CSV format
I suggest Excel. Then you can read our row-by-row, column-by-column. Note that Excel can directly open such a file.
0
 
LVL 7

Expert Comment

by:FER_G
ID: 24358731
Taylor814; replace your code, with the code snippet below

FerG.
Saludos.
--
Ing. Fernando D. Giletta
San Francisco. Córdoba. Argentina.

Private Sub mnuLoadCSV_Click()

   call LoadCSV

end sub
 

Private Sub LoadCSV()

    Dim strRecord As String

    Dim sTokens() As String

    

    On Error GoTo Errors

    

    Dim FileName As String, lngFreeFile As Long

    With CommonDialog1

        .FileName = ""

        .InitDir = App.Path & "\lists"

        .Filter = "CSV Files (*.csv)|*.csv"

        .ShowOpen

        If (.FileName <> "") Then

            FileName = .FileName

        Else

            MsgBox "YOU MUST SELECT A CORRECT FILE"

            Exit Sub

        End If

    End With

    

    lngFreeFile = freeFile

    'FileName = "C:\WINDOWS\Profiles\giletta.WINDOWS2000\Escritorio\borrar.txt"

    

    Open FileName For Input As #lngFreeFile

    

    With MSFlexGrid

        .Rows = 1

        Do While Not EOF(lngFreeFile)

            Line Input #lngFreeFile, strRecord

            sTokens = Split(strRecord, ",")

            

            If (UBound(sTokens) > .Cols) Then

                .Cols = UBound(sTokens)

            End If

            

            .Rows = .Rows + 1

            For i = LBound(sTokens) To UBound(sTokens) - 1

                .TextMatrix(.Rows - 1, i) = Replace(sTokens(i), Chr(34), "")

            Next

        Loop

    End With

    

    Close #lngFreeFile

    Exit Sub
 

Errors:

    MsgBox Err.Number & vbCrLf & Err.Description

End Sub

Open in new window

0
 

Author Comment

by:Taylor814
ID: 24360623
Fer_G: Thanks, but unfortunately that code doesn't work for this line:

06/06/2009,11:00 AM,"Tastin and Racin Festival","Lake Sammamish State Park, 2000 NW Sammamish Road","Issaquah",WA,"98027",US,"","",,"","",""

Notice how "Lake Sammamish State Park, 2000 NW Sammamish Road" has a comma. It shouldn't be split.
0
 

Author Comment

by:Taylor814
ID: 24360629
GrahamSkan: Thanks for your suggestion, but I'm making this program to do other things that Excel can't.
0
 
LVL 16

Expert Comment

by:HooKooDooKu
ID: 24360932
Here's a pair of functions I wrote back in the day of VB6.  It takes a string, a delimiter, and an index, and extracts the indexed sub-string between two delimiters.  It's not lightning fast (as is processes the same string over and over to get each indexed sub-string) but it does work and includes the option to ignore delimiters within quotation marks.
'Given a String, Overwrite charators between Quotation Marks with NUL

'(i.e. 'ABC"DEF"GHI' ==> 'ABC"___"GHI')

Public Function NullBetweenQuotes(Str As String) As String

Dim StartPos As Long    'Starting Position of Nth item in Text

Dim EndPos   As Long    'Ending   Position of Nth item in Text

Dim LenStr   As Long    'Length of Str

Dim LenStartEnd As Long 'Length from StartPos to EndPos
 

    'Initialize

    Debug.Assert Len(EscapeChar) = 1

    LenStr = Len(Str)

    NullBetweenQuotes = Str
 

    'Find First Open Quote

    StartPos = InStr(NullBetweenQuotes, QUOTATION_MARK)

    

    Do While StartPos

    

        'Find Matching Close Quote

        EndPos = InStr(StartPos + 1, NullBetweenQuotes, QUOTATION_MARK)

        

        'If None Found - Pretend there is an extra Quotation Mark at end of string

        If EndPos = 0 Then

            EndPos = LenStr + 1

        End If

        

        'Fill Between Quoates with NULLs

        If StartPos < LenStr Then

            LenStartEnd = EndPos - StartPos - 1

            Mid$(NullBetweenQuotes, StartPos + 1, LenStartEnd) = String$(LenStartEnd, vbNullChar)

        End If

        

        'Find Next Open Quote

        StartPos = InStr(EndPos + 1, NullBetweenQuotes, QUOTATION_MARK)

    Loop

    

End Function

'Given a String and a Delimiter, Return the Nth section of the string (Only uses 1st Char of Delimiter)

'Function is 1 Base (N=1 is 1st Element), N=0 always returns ""

'If 'DealWithQuotes' specified, Delimiters located within Quotes are ignored

Public Function Nth$(Str As String, N As Integer, Delimiter As String, Optional DealWithQuotes As Boolean = False)

Dim StartPos As Long        'Start of the Nth item

Dim EndPos   As Long        'End   of the Nth item

Dim SearchString As String  'Copy of Str used to Perform Search on (so that NullBetween Quotes can be used without modifying the original string

Dim I As Long               'Iterator to search N times
 

    Debug.Assert Len(Delimiter) = 1

    Debug.Assert Len(EscapeChar) = 1

    

    'Create SearchString (make sure it Ends with a Delimiter so that we are guarenteed to find at least one

    If DealWithQuotes Then

        SearchString = NullBetweenQuotes(Str) & Delimiter   

    Else

        SearchString = Str & Delimiter

    End If

    Debug.Assert Right$(SearchString, 1) = Delimiter

    

    'Find the Nth Delimiter (it Ends the Nth$)

    EndPos = 0

    For I = 1 To N

    

        'Remeber the Last Delimter + 1

        StartPos = EndPos + 1

        

        'Find the Next Delimeter

        EndPos = InStr(EndPos + 1, SearchString, Delimiter)

        

        If EndPos = 0 Then

            EndPos = Len(SearchString) + 1

            StartPos = EndPos

            Exit For

        End If

        

    Next I

    

    'Extract the Nth$

    If EndPos = 0 Then

        Nth$ = ""

    Else

        Nth$ = Mid$(Str, StartPos, EndPos - StartPos)

    End If

    

End Function

Open in new window

0
 
LVL 11

Expert Comment

by:Antagony1960
ID: 24362288
Why not just remove all instances of quotes which are adjacent to commas?
    strRecord = Replace(strRecord, Chr(34) & "," & Chr(34), ",")    'Handles ","

    strRecord = Replace(strRecord, Chr(34) & ",", ",")              'Handles ",

    strRecord = Replace(strRecord, "," & Chr(34), ",")              'Handles ,"

Open in new window

0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 11

Expert Comment

by:Antagony1960
ID: 24362331
^ Of course that will only work if you can be sure that there will be no commas between the quoted texts. If that's a possibility you will first have to step through the entire string, one character at a time, and temporarily replace internal commas with another character, so that those commas which are not delimiters won't be used as such. And then step through the split data and restore instances of the temporary character back to commas. That shouldn't be too difficult though.
0
 
LVL 11

Expert Comment

by:Antagony1960
ID: 24362489
^ Ah, I see from your follow up comment that you do indeed have instances where there are commas in the quoted text. I should have read all the thread before replying!

No matter, it's easy enough to handle that in the manner I described previously:
Dim i As Integer, bInQoutes As Boolean

    For i = 1 To Len(strRecord)

        If Mid(strRecord, i, 1) = Chr(34) And Not bInQoutes Then    'Start of quoted text

            bInQoutes = True

        ElseIf Mid(strRecord, i, 1) = "," And bInQoutes Then        'Comma within quotes found

            Mid(strRecord, i, 1) = "R"                              'Set to obscure character Chr(140)

        ElseIf Mid(strRecord, i, 1) = Chr(34) And bInQoutes Then    'End of quoted text

            bInQoutes = False

        End If

    Next

    strRecord = Replace(strRecord, Chr(34) & "," & Chr(34), ",")    'Handles ","

    strRecord = Replace(strRecord, Chr(34) & ",", ",")              'Handles ",

    strRecord = Replace(strRecord, "," & Chr(34), ",")              'Handles ,"

    sTokens = Split(strRecord, ",")

    For i = 0 To UBound(sTokens)

        sTokens(i) = Replace(sTokens(i), "R", ",")                   'Restore internal commas

    Next

Open in new window

0
 
LVL 11

Expert Comment

by:Antagony1960
ID: 24362510
^ Damn... the software here has translated the obscure character in lines 6 & 16 as an R. You should either replace "R" with Chr(140) on those lines or type ?Chr(140) into the immediate window and replace the R with the outputted character.
0
 
LVL 7

Accepted Solution

by:
FER_G earned 500 total points
ID: 24364169
Taylor814; replace the previous code, with the code snippet below.

FerG.
Saludos.
--
Ing. Fernando D. Giletta
San Francisco. Córdoba. Argentina.
Private Sub mnuLoadCSV_Click()

   call LoadCSV

end sub

 

Private Sub LoadCSV()

    Dim strRecord As String

    Dim sTokens() As String

    

    On Error GoTo Errors

    

    Dim FileName As String, lngFreeFile As Long

    With CommonDialog1

        .FileName = ""

        .InitDir = App.Path & "\lists"

        .Filter = "CSV Files (*.csv)|*.csv"

        .ShowOpen

        If (.FileName <> "") Then

            FileName = .FileName

        Else

            MsgBox "YOU MUST SELECT A CORRECT FILE"

            Exit Sub

        End If

    End With

    

    lngFreeFile = freeFile    

    Open FileName For Input As #lngFreeFile

    

    With MSFlexGrid

        .Rows = 1

        Do While Not EOF(lngFreeFile)

            Line Input #lngFreeFile, strRecord

            'sTokens = Split(strRecord, ",")

            sTokens = ContenidoLineaArchivo2(strRecord, ",")
 

            If (UBound(sTokens) + 1 > .Cols) Then

                .Cols = UBound(sTokens) + 1

            End If

            

            .Rows = .Rows + 1

            For i = LBound(sTokens) To UBound(sTokens)

                .TextMatrix(.Rows - 1, i) = Replace(sTokens(i), Chr(34), "")

            Next

        Loop

    End With

    

    Close #lngFreeFile

    Exit Sub

 

Errors:

    MsgBox Err.Number & vbCrLf & Err.Description

End Sub
 

Public Function ContenidoLineaArchivo2(lineaArchivo As String, caracterSeparador As String) As String()

    

    Dim Comilla As String, caracterRaro As String

    Comilla = Chr(34)

    caracterRaro = Chr(140)

    

    Dim i As Integer, bInQuotes As Boolean

    For i = 1 To Len(lineaArchivo)

        If (Mid(lineaArchivo, i, 1) = Comilla) And Not bInQuotes Then           'Start of quoted text

            bInQuotes = True

        ElseIf (Mid(lineaArchivo, i, 1) = caracterSeparador) And bInQuotes Then 'Comma within quotes found

            Mid(lineaArchivo, i, 1) = caracterRaro                                  'Set to obscure character Chr(140)

        ElseIf Mid(lineaArchivo, i, 1) = Comilla And bInQuotes Then             'End of quoted text

            bInQuotes = False

        End If

    Next

    lineaArchivo = Replace(lineaArchivo, Comilla, "")

    

    Dim cadenas() As String

    cadenas = Split(lineaArchivo, caracterSeparador)

    For i = 0 To UBound(cadenas)

        cadenas(i) = Replace(cadenas(i), caracterRaro, caracterSeparador)                   'Restore internal commas

    Next

    ContenidoLineaArchivo2 = cadenas

End Function

Open in new window

0
 
LVL 4

Expert Comment

by:Ledigimate
ID: 24366635
The above solution correctly parses a standard CSV file that has commas within quoted values.

From what I can understand, you originally wanted a way to split a string in the same way that the Split funtion does, only you want to specify two delimiting characters instead of a single character.  The Split function accepts only a single delimiting character.  The only way to use two delimiting characters would be to write your own "Split" funtion that accepts a string with two (or more) characters in its delimiter parameter.

Below is an example (with no error-handling).

Ledigimate.
Function SplitString(Expression As String, Delimiter As String) As String()

    Dim StringArray() As String, _

        StringCount As Integer, MidStart As Integer, InStrValue As Integer, _

        DelimiterLength As Byte

    StringCount = 1

    MidStart = 1

    DelimiterLength = Len(Delimiter)

    InStrValue = InStr(MidStart, Expression, Delimiter)

    Do While InStrValue > 0

        ReDim Preserve StringArray(StringCount - 1)

        StringArray(StringCount - 1) = Mid(Expression, MidStart, InStrValue - 1)

        StringCount = StringCount + 1

        MidStart = InStrValue + DelimiterLength

        InStrValue = InStr(MidStart, Expression, Delimiter)

    Loop

    ReDim Preserve StringArray(StringCount - 1)

    StringArray(StringCount - 1) = Right$(Expression, Len(Expression) - (MidStart - 1))

    SplitString = StringArray

End Function

Open in new window

0
 
LVL 4

Expert Comment

by:Ledigimate
ID: 24366713
NO, don't use the buggy example above as is.  Change line 11 to

        StringArray(StringCount - 1) = Mid(Expression, MidStart, InStrValue - MidStart)

Ledigimate.
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now