I have a record called ouderecord I get from a table with a SQL statement.
I have this code:
strSQL = "SELECT * from tblS1lijst where id = " & Keuzelijst3.Column(0)
Debug.Print strSQL
ouderecord = CurrentDb.OpenRecordset(strSQL)
Tmpstr = Mid(Keuzelijst3.Column(2), InStr(1, Keuzelijst3.Column(2), ".") + 1, _
Len(Keuzelijst3.Column(2)) - InStr(1, Keuzelijst3.Column(2), ".") - 1)
veld_naam = "[" & Tmpstr & "]"
tekst = "ouderecord!" & veld_naam
Debug.Print tekst
When I hover over the text (ouderecord![Situatie]) in the Direct window, I see the contents of the field. How do I get that content in a variable?
I want "Situatie" as a variable.
If the name of the field is static, you can do it like this
Dim tekst As String
tekst = Nz(ouderecord![Situatie])
or
tekst = Nz(ouderecord!Situatie)
The [ and ] are only required if the column name contains invalid characters like a space character or a hyphen or if it conflicts with a keyword.
But if the name is given dynamically in a variable, you must access the Fields default property of the Recordset
tekst = Nz(ouderecord(veld_naam))
This is the same as
tekst = Nz(ouderecord.Fields(veld_naam).Value)
Where veld_naam must be the name of the field without the column name escapes [ and ]: E.g., veld_naam = "Situatie"
Note that the parameter can be either a String representing the name of the field or an Integer representing the index of the column in the query.
The Nz function converts NULL values into and appropriate value for the given type. In this case it returns an empty string for NULL.
That Nz did the trick!
I now have
strSQL = "SELECT * from tblS1lijst where id = " & Keuzelijst3.Column(0)
Debug.Print strSQL
ouderecord = CurrentDb.OpenRecordset(strSQL)
Tmpstr = Mid(Keuzelijst3.Column(2), InStr(1, Keuzelijst3.Column(2), ".") + 1, Len(Keuzelijst3.Column(2)) - InStr(1, Keuzelijst3.Column(2), ".") - 1)
veld_naam = "[" & Tmpstr & "]"
tekst = "ouderecord!" & veld_naam
tekst = Nz(ouderecord(veld_naam))
Debug.Print tekst
And that works.
Related
I have a form (frmSearch) that I use several (4) comboboxes to filter out results for a listbox (lstCustomers). What I'm attempting to do now is create the ability to filter the listbox based on a text box of "keywords". Additionally, the column which the keyword box will search will be variable based on cboWhere which is a list of columns from tblContacts (the table qryContactWants uses)
I found a really nice Function set with the following code that will let me filter everything, but I'm not entirely sure how to turn this data around and use it to filter out my listbox.
This function organizes the keywords:
Public Function FindAnyWord(varFindIn, strWordList As String) As Boolean
Dim var
Dim aWords
aWords = Split(strWordList, ",")
For Each var In aWords
If FindWord(varFindIn, var) Then
FindAnyWord = True
Exit Function
End If
Next var
End Function
And this function actually performs the search:
Public Function FindWord(varFindIn As Variant, varWord As Variant) As Boolean
Const PUNCLIST = """' .,?!:;(){}[]-—/"
Dim intPos As Integer
FindWord = False
If Not IsNull(varFindIn) And Not IsNull(varWord) Then
intPos = InStr(varFindIn, varWord)
' loop until no instances of sought substring found
Do While intPos > 0
' is it at start of string
If intPos = 1 Then
' is it whole string?
If Len(varFindIn) = Len(varWord) Then
FindWord = True
Exit Function
' is it followed by a space or punctuation mark?
ElseIf InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
Else
' is it precedeed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos - 1, 1)) > 0 Then
' is it at end of string or followed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
End If
End If
' remove characters up to end of first instance
' of sought substring before looping
varFindIn = Mid(varFindIn, intPos + 1)
intPos = InStr(varFindIn, varWord)
Loop
End If
End Function
And here is the code that I typically use to filter the listbox using the comboboxes on frmSearch:
Dim column As String
SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
& "FROM qryContactWants " _
& "WHERE 1=1 "
If cboType.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
End If
If cboMake.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
End If
If cboModel.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
End If
If cboYear.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
End If
If cboCondition.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
End If
SQL = SQL & " ORDER BY qryContactWants.Last"
Me.lstCustomers.RowSource = SQL
Me.lstCustomers.Requery
End Sub
What I would like to do is take the functions I found for searching keywords and apply it to my form and aid in returning a list of customers in lstCustomers
Ideally, having the keyword function return an SQL statement similar to those I'm using to filter out the listbox would be perfect. This would allow me to add a simple SQL = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING
EDIT 1:
While using the following code, VBA is tossing a compile error on the second "End If" stating there isn't a Block If. There clearly is, so I'm not sure what's going on. Here is the code I'm using:
Public Function KeyWhere(strKeys As String, strColumn As String) As String
Dim b As Variant
strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns
b = Split(strKeys, ",")
Dim strWhere As String
Dim v As Variant
For Each v In b
If Trim(b) <> "" Then
If strWhere <> "" Then strWhere = strWhere & " or "
strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
End If
End If
Next
strWhere = "(" & strWhere & ")"
KeyWhere = strWhere
End Function
And under the function RequerylistCustomers() I added the If IsNull (Me.txtSearch) = False Then code below:
Private Sub RequerylstCustomers()
Dim SQL As String
'Dim criteria As String
Dim column As String
SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
& "FROM qryContactWants " _
& "WHERE 1=1 "
If cboType.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
End If
If cboMake.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
End If
If cboModel.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
End If
If cboYear.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
End If
If cboCondition.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
End If
Dim strWhere As String
'Grab Keywords from txtSearch using cboWhere to search for those keywords
If IsNull(Me.txtSearch) = False Then
strWhere = KeyWhere(Me.txtSearch, Me.cboWhere)
SQL = SQL & " AND " & strWhere
End If
SQL = SQL & " ORDER BY qryContactWants.Last"
Me.lstCustomers.RowSource = SQL
Me.lstCustomers.Requery
End Sub
Are the keywords to be searched in a single column (say a comments or memo column?). If yes, then you should be able to optional "add" the one additional criteria to your current "set" of combo box filters.
Are we to assume that the keywords can appear anywhere in that memo column to search?
So, if there are "key words entered into that text box, then you call KeyWhere.
eg this routine:
Public Function KeyWhere(strKeys As String, strColumn As String) As String
Dim b As Variant
strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns
b = Split(strKeys, ",")
Dim strWhere As String
Dim v As Variant
For Each v In b
if trim(v) <> "" then
If strWhere <> "" Then strWhere = strWhere & " or "
strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
end if
Next
strWhere = "(" & strWhere & ")"
KeyWhere = strWhere
End Function
We assume each key word is separated by a comma (could be space, but comma is better).
So, if I type in the following command in debug window to test the above?
? keywhere("Generator, Water maker, Battery","Notes")
OutPut:
(Notes like '*Generator*' or Notes like '*Water maker*' or Notes like '*Battery*')
So, we just append the above results to your final SQL.
eg:
dim strWhere as string
if isnull(me.KeyWordBox) = False then
strWhere = keyWhere(me.KeyWordBox,me.cboColumnToSearch)
SQL = SQL & " AND " & strWhere
end if
so, the above converts all keywords into a valid SQL condition for the column to search. It is likely that column is some kind of notes column, but it would work for other description type field to search.
I am trying to create a dynamic SQL string builder for my application and am having some issues with encapsulating the fieldnames with brackets.
My code is as follows:
Public Sub BuildDynamicSQL( _
FieldsArray() As String, _
ByVal TableName As String)
' Declarations ->
Dim strSQL As String: strSQL = vbNullString
Dim Field As Variant
Dim i As Integer: i = 0
' Validate fields array ->
If IsEmpty(FieldsArray) Then Exit Sub
' Construct SQL using Fields array ->
strSQL = "SELECT "
For Each Field In FieldsArray
If i = 0 Then
strSQL = strSQL + "[" + Field + "]"
Else
strSQL = strSQL + "," + "[" + Field + "]"
End If
i = i + 1
Next
strSQL = strSQL + " FROM " + TableName
End Sub
When I run this code with more than one field in my FieldsArray, I keep getting the following output with unnecessary leading spaces.
SELECT [log_id],[ log_description],[ create_user],[ create_date_time] FROM activity_log
Has anyone got any idea how I can get this to work as expected?
Many thanks.
Here is a generalized example of a function accepting a paramarray argument and returning a string.
Option Explicit
Sub main()
Dim sql As String
sql = buildMySql("mytable")
Debug.Print sql
sql = buildMySql("mytable", "fld1", "fld2", "fld3", "fld4")
Debug.Print sql
End Sub
Function buildMySql(tbl As String, ParamArray flds()) As String
Dim str As String, f As Long
If IsMissing(flds) Then
str = "select * from [" & tbl & "];"
Else
str = "select "
For f = LBound(flds) To UBound(flds)
str = str & "[" & flds(f) & "]" & IIf(f < UBound(flds), Chr(44), vbNullString)
Next f
str = str & " from [" & tbl & "];"
End If
buildMySql = str
End Function
'results
select * from [mytable];
select [fld1],[fld2],[fld3],[fld4] from [mytable];
I have a field called "sku" which uniquely identifies products on the table, there are about 38k products. I have a "sku generator" which uses other fields in the table to create the SKU. It's worked perfectly without an issue until I started producing SKUs for a large amount of products. I would launch the generator and it would stop around 15,000 and say "System Resource exceeded" and highlight the following code in the function:
Found = IsNull(DLookup("sku", "Loadsheet", "[sku]='" & TempSKU & "'"))
I didn't have time to fully fix the issue, so a temporary fix for me was to split the database in two, and run the sku generator seperately on both files. Now that I have more time I want to investigate why exactly it gets stuck around this number, and if there's a possibility of fixing this issue (it would save some time with splitting files and then grouping them again). I also have an issue with it getting really slow at times, but I think it's because it's processing so much when it runs. Here is the function
Option Compare Database
Private Sub Command2_Click() 'Generate SKU
Command2.Enabled = False: Command3.Enabled = False: Command2.Caption = "Generating ..."
Me.RecordSource = ""
CurrentDb.QueryDefs("ResetSKU").Execute
Me.RecordSource = "loadsheet_4"
Dim rs As Recordset, i As Long
Set rs = Me.Recordset
rs.MoveLast: rs.MoveFirst
For i = 0 To rs.RecordCount - 1
rs.AbsolutePosition = i
rs.Edit
rs.Fields("sku") = SetSKU(rs)
rs.Update
DoEvents
Next
Command2.Enabled = True: Command3.Enabled = True: Command2.Caption = "Generate SKU"
End Sub
Public Function SetSKU(rs As Recordset) As String
Dim TempStr As String, TempSKU As String, id As Integer, Found As Boolean, ColorFound As Variant
id = 1: ColorFound = DLookup("Abbreviated", "ProductColors", "[Color]='" & rs.Fields("single_color_name") & "'")
TempStr = "ORL-" & UCase(Left(rs.Fields("make"), 2)) & "-"
TempStr = TempStr & Get1stLetters(rs.Fields("model"), True) & rs.Fields("year_dash") & "-L-"
TempStr = TempStr & "WR-"
TempStr = TempStr & IIf(IsNull(ColorFound), "?", ColorFound) & "-4215-2-"
TempStr = TempStr & rs.Fields("color_code")
TempSKU = Replace(TempStr, "-L-", "-" & ADDZeros(id, 2) & "-L-")
Found = IsNull(DLookup("sku", "Loadsheet", "[sku]='" & TempSKU & "'"))
While Found = False
id = id + 1
TempSKU = Replace(TempStr, "-L-", "-" & ADDZeros(id, 2) & "-L-")
Found = IsNull(DLookup("sku", "Loadsheet", "[sku]='" & TempSKU & "'"))
Wend
If id > 1 Then
' MsgBox TempSKU
End If
SetSKU = TempSKU
End Function
Public Function Get1stLetters(Mystr As String, Optional twoLetters As Boolean = False) As String
Dim i As Integer
Get1stLetters = ""
For i = 0 To UBound(Split(Mystr, " ")) 'ubound gets the number of the elements
If i = 0 And twoLetters Then
Get1stLetters = Get1stLetters & UCase(Left(Split(Mystr, " ")(i), 2))
GoTo continueFor
End If
Get1stLetters = Get1stLetters & UCase(Left(Split(Mystr, " ")(i), 1))
continueFor:
Next
End Function
Public Function ADDZeros(N As Integer, MAX As Integer) As String
Dim NL As Integer
NL = Len(CStr(N))
If NL < MAX Then
ADDZeros = "0" & N 'StrDup(MAX - NL, "0") & N
Else: ADDZeros = N
End If
End Function
Notes: This function also calls other functions as well that adds a unique identifier to the SKU and also outputs the first letter of each word of the product
Also I'm running on 64 bit access.
If you require any other info let me know, I didn't post the other functions but if needed let me know.
thanks.
I am not 100% sure how you have split the Database into two files and that you are running the generator on both files. However I have a few suggestion to the function you are using.
I would not pass the recordset object to this function. I would rather pass the ID or unique identifier, and generate the recordset in the function. This could be a good start for efficiency.
Next, declare all objects explicitly, to avoid library ambiguity. rs As DAO.Recordset. Try to make use of inbuilt functions, like Nz().
Could Get1stLetters method be replaced with a simple Left() function? How about ADDZeros method?
Using DLookup might be a bit messy, how about a DCount instead? Could the following be any use now?
Public Function SetSKU(unqID As Long) As String
Dim TempStr As String, TempSKU As String
Dim id As Integer
Dim ColorFound As String
Dim rs As DAO.Recordset
id = 1
Set rs = CurrentDB.OpenRecordset("SELECT single_color_name, make, model, year_dash, color_code " & _
"FROM yourTableName WHERE uniqueColumn = " & unqID)
ColorFound = Nz(DLookup("Abbreviated", "ProductColors", "[Color]='" & rs.Fields("single_color_name") & "'"), "?")
TempStr = "ORL-" & UCase(Left(rs.Fields("make"), 2)) & "-"
TempStr = TempStr & Get1stLetters(rs.Fields("model"), True) & rs.Fields("year_dash") & "-L-"
TempStr = TempStr & "WR-"
TempStr = TempStr & ColorFound & "-4215-2-"
TempStr = TempStr & rs.Fields("color_code")
TempSKU = Replace(TempStr, "-L-", "-" & ADDZeros(id, 2) & "-L-")
While DCount("*", "Loadsheet", "[sku]='" & TempSKU & "'") <> 0
id = id + 1
TempSKU = Replace(TempStr, "-L-", "-" & ADDZeros(id, 2) & "-L-")
Wend
If id > 1 Then
'MsgBox TempSKU'
End If
Set rs = Nothing
SetSKU = TempSKU
End Function
A common usage of VBA at my company is generation of source code based on information entered in Excel tables. Given VBA's native string manipulation, the code that does this is tedious to write and not very readable.
A simple example (these get more complex) is:
Print #fileIdentifier, SSpace(9) & "update_" & print_string & "[" & CStr(j) & "] <= 1'b0;"
Print #fileIdentifier, SSpace(9) & print_string & "_ack_meta" & "[" & CStr(j) & "] <= 1'b0;"
Print #fileIdentifier, SSpace(9) & print_string & "_ack_sync" & "[" & CStr(j) & "] <= 1'b0;"
I am looking for a solution in VBA that would allow me to specify this using a "text template", so define a text that would look something like this
update_#name#[#bit#] <= 1'b0;
#name#_ack_meta[#bit#] <= 1'b0;
#name#_ack_sync[#bit#] <= 1'b0;
and have a function/method call, passing the values of #name# and #bit#, replace all instances of #name# and #bit# with corresponding values.
Basic insertion function:
Function insert(template As String, ParamArray inserts() As Variant) As String
Dim i As Long
For i = 0 To UBound(inserts)
template = Replace$(template, "%" & i + 1 & "%", inserts(i))
Next
'// some special cases perhaps
template = Replace$(template, "%SSPACE%", SSpace(9))
template = Replace$(template, "\r\n", VbCrLf)
insert = template
End Function
For
?insert("Foo %1% Bar %2% Qux %3% (%1%)", "A", "B", "C")
Foo A Bar B Qux C (A)
Map (add a reference to Microsoft Scripting Runtime):
Dim col As New Scripting.Dictionary
col("name") = "bob"
col("age") = 35
MsgBox insert2("Hello %name% you are %age%", col)
...
Function insert2(template As String, map As Scripting.Dictionary) As String
Dim name
For Each name In map.Keys()
template = Replace$(template, "%" & name & "%", map(name))
Next
insert2 = template
End Function
Alex K., thank you for the solution.
Here is how I expanded it (please feel free to let me know if there is a better way of doing this)
Function FillTemplateGeneric(template As Variant, map As Scripting.Dictionary) As String
Dim name
Dim out_text As String
' Handle multiple ways of receiving the template string
If VarType(template) = vbString Then
out_text = template
ElseIf VarType(template) = vbArray Then
out_text = Join(template, vbCrLf)
ElseIf TypeName(template) = "String()" Then
out_text = Join(template, vbCrLf)
ElseIf TypeName(template) = "Variant()" And TypeName(template(LBound(template, 1))) = "String" Then
out_text = Join(template, vbCrLf)
Else
MsgBox "Unknown Var Type passed to FillTemplateGeneric as first argument:" & vbCrLf & TypeName(template)
Err.Raise vbObjectError + 513, "FillTemplateGeneric", "Unknown Var Type passed to FillTemplateGeneric as first argument:" & vbCrLf & TypeName(template)
End If
For Each name In map.Keys()
out_text = Replace$(out_text, "%" & name & "%", map(name))
Next
FillTemplateGeneric = out_text
End Function
This allows for it to accept calls in multiple formats:
' Common dictionary for expansion
Dim col As New Scripting.Dictionary
col("name") = print_string
' Using inline text for template
MsgBox FillTemplateGeneric("test text with %name% name - just string", col)
' Using a multi-line string
Dim template As String
templ_text = " update_%name% <= 1'b0; // 1 - manual multi-line string" & _
vbCrLf & " %name%_ack_meta <= 1'b0; // " & _
vbCrLf & " %name%_ack_sync <= 1'b0; // "
MsgBox FillTemplateGeneric(templ_text, col)
' Using an array of strings
Dim ttext(1 To 3) As String
ttext(1) = " update_%name% <= 1'b0; // 2 - manual array of strings"
ttext(2) = " %name%_ack_meta <= 1'b0; // "
ttext(3) = " %name%_ack_sync <= 1'b0; // "
MsgBox FillTemplateGeneric(ttext, col)
' Using an inline array of strings
MsgBox FillTemplateGeneric(Array( _
" update_%name% <= 1'b0; // 3 - immediate array of strings", _
" %name%_ack_meta <= 1'b0; // ", _
" %name%_ack_sync <= 1'b0; // " _
), col)
tl:dr
How can I programatically flag a quotation mark (") when it is not a quote-comma (",) or a comma-quote (,")?
I am running a program that opens csv files, reads each line, then splits the line based on the location of the commas. There are enough text strings that have quotes in them, so I am using
filereader1.HasFieldsEnclosedInQuotes = True
However, when the files were created, there was no regard for having even numbers of quotes in the lines. Most of the time, it's not a big deal. There are only a couple of instances per folder of files.
But, I'm running into a few where it's a huge number. Dozens of instances in a file of several thousand lines. There isn't a simple way to manually error-check these.
So, I'm trying to do a verify that a string has rogue quotes. A comma-quote (,") or quote-comma ("), would be okay, but a quote (") just floating around would pull up an input box displaying the text line for manual fixes.
I can't use an odd number of quotes, because I've found even numbers of error quotes.
Below is the code as it stands.
Using filereader1 As New Microsoft.VisualBasic.FileIO.TextFieldParser(files_(i))
filereader1.TextFieldType = FieldType.Delimited
filereader1.Delimiters = New String() {","}
filereader1.HasFieldsEnclosedInQuotes = True
While Not filereader1.EndOfData
'While (filereader1.EndOfData = False) ' looks for the end of the file and resets stuff
split_string = filereader1.ReadFields()
This is something of what I am thinking.
I would like to run a readline instead of a readfield, and I would assign that to a variable. If the readline had a quote, but that could not be a quote-comma OR a comma-quote, the variable would get displayed in an input box for manual updating. Then the fixed variable would get parsed into the split_string array.
If the quotes all fit the rule above, the string would get parsed normally.
Could you do a count of the different type of strings in the readLine, and if the count of all quotes versus the sum of all ", and ," don't match, then you have an issue?
Public Function CountChar(originalString As String, findString As String) as Long
Dim lLen As Long = 0
Dim lCharLen As Long = 0
Dim lAns As Long = 0
Dim sChar As String = ""
Dim lCtr As Long = 0
Dim lEndOfLoop As Long = 0
lLen = Len(originalString)
lCharLen = Len(findString)
lEndOfLoop = (lLen - lCharLen) + 1
For lCtr = 1 To lEndOfLoop
sChar = Mid(originalString, lCtr, lCharLen)
If StrComp(sChar, findString, vbTextCompare) = 0 Then lAns = lAns + 1
Next
return lAns
End Function
Usage
'if the count of all quotes does not equal count of ", + ,", then there is an issue.
if CountChar(thisLine, chr(34)) <> (countChar(thisLine, chr(34) & ",") + countChar(thisLine, & "," & chr(34)) then
'rogue quotes
end if
So, this is what I ended up doing.
I read each line from the csv file.
I check to see how many quotes are in the line.
If the number is zero, I parse based on commas alone.
If there are an odd number of quotes, I eliminate ALL the quotes in the line, and send it to the manual error-checking.
If there are an even number of quotes, I replace the character string ," and ", with ::
Then I parse the line on both commas and ::
This seems to be working.
Using filereader As New Microsoft.VisualBasic.FileIO.TextFieldParser(files_(i), System.Text.Encoding.Default) 'system text decoding adds odd characters
While Not filereader.EndOfData
filereader.TextFieldType = FieldType.Delimited
'filereader.Delimiters = New String() {","}
filereader.SetDelimiters(",") 'tried new from Don's program 6/12
filereader.HasFieldsEnclosedInQuotes = True
filereader.TextFieldType = FieldType.Delimited
Try
'split_string = filereader1.ReadFields()
whole_string = filereader.ReadLine()
Catch ex As Microsoft.VisualBasic.FileIO.MalformedLineException
MessageBox.Show(ex.Message & " : " & FileName & " ; " & filereader.ErrorLine)
error_throw = filereader.ErrorLine
error_throw = error_throw.Replace("""", " ")
split_string = Split(error_throw, ",")
'MsgBox("In catch routine, split string (0) " & split_string(0))
End Try
Dim cnt As Integer = 0
Dim MyRegex As New Regex("""[^""]*""|(,)")
For Each c As Char In whole_string
If c = """" Then cnt = cnt + 1
Next
'MsgBox("cnt = " & cnt)
If cnt = 0 Then 'no quotes
split_string = Split(whole_string, ",") 'split by commas
'MsgBox("no quotes")
ElseIf cnt Mod 2 = 0 Then 'even number of quotes
Dim pattern1 As String = "\.?(,"")+"
Dim pattern2 As String = "\.?("",)+"
Dim rgex1 As New Regex(pattern1)
Dim rgex2 As New Regex(pattern2)
Dim replace1 As String = "::"
Dim replace2 As String = "::"
Dim whole_string1 As String = rgex1.Replace(whole_string, replace1)
Dim whole_string2 As String = rgex2.Replace(whole_string1, replace2)
whole_string1 = rgex1.Replace(whole_string, replace1)
whole_string2 = rgex2.Replace(whole_string1, replace2)
'MsgBox(whole_string & " >> " & whole_string1 & " >> " & whole_string2)
'split_string = Split(whole_string2, ",") 'non-regex code that allows program to run
split_string = Regex.Split(whole_string2, ",|([<::>+].*[<::>+])")
'(",(?=(?:[^\""]*\""[^\""]*\"")*(?![^\""]*\""))")
'MsgBox("Before " & split_string(0) & " | " & split_string(1) & " | " & split_string(2) & " | " & split_string(3) & " | " & split_string(4) & " | " & split_string(5) & " | " & split_string(6) & " | " & split_string(7))
Dim arraycount_2 As Integer = split_string.getupperbound(0)
For p = 0 To arraycount_2
split_string(p) = split_string(p).replace("::", "")
Next
'MsgBox("After " & split_string(0) & " | " & split_string(1) & " | " & split_string(2) & " | " & split_string(3) & " | " & split_string(4) & " | " & split_string(5) & " | " & split_string(6) & " | " & split_string(7))
ElseIf cnt Mod 2 <> 0 Then 'odd number of quotes
'MsgBox("Odd quotes")
whole_string = whole_string.Replace("""", " ") 'delete all quotes
split_string = Split(whole_string, ",") 'split by commas
Else
' MsgBox("no answer to ENTRY splitting of Whole_string")
End If