Solved

How do you split by two delimiters?

Posted on 2009-05-11
12
889 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
[Live Webinar] The Cloud Skills Gap

As Cloud technologies come of age, business leaders grapple with the impact it has on their team's skills and the gap associated with the use of a cloud platform.

Join experts from 451 Research and Concerto Cloud Services on July 27th where we will examine fact and fiction.

 

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
 
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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month4 days, 11 hours left to enroll

636 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