I'm trying to compare two datatables and I'm doing some tests using DataTable.Select on two identical datatables:
Using DT_NewData As DataTable = DT_DBData.Copy
For x As Short = 0 To DT_NewData.Rows.Count - 1
Dim SelRows As DataRow() = DT_DBData.Select( _
"Type='" & DT_NewData.Rows(x)("Type") & "'" & _
" AND In_Date='" & DT_NewData.Rows(x)("In_Date") & "'" & _
" AND Out_Date='" & DT_NewData.Rows(x)("Out_Date") & "'")
Next
But SelRows.Length is always 0. What's wrong in my code?
Although is a little strange the copy of the table, try this:
Suppose that Type is String
Imports Microsoft.VisualBasic
Imports System.Linq
Module StartupModule
Sub Main()
' Declare the table.
Dim originalDataTable As New DataTable
' Declare the table columns.
With originalDataTable.Columns
.Add("Type", GetType(String))
.Add("InDate", GetType(DateTime))
.Add("OutDate", GetType(DateTime))
End With
' Delegate to add rows.
Dim addRow As Action(Of String, DateTime?, DateTime?) = Sub(text, inDate, outDate)
Dim newRow As DataRow = originalDataTable.NewRow()
With newRow
If (Not String.IsNullOrEmpty(text)) Then
.SetField(Of String)("Type", text)
End If
If (inDate.HasValue) Then
.SetField(Of DateTime?)("InDate", inDate.Value)
End If
If (outDate.HasValue) Then
.SetField(Of DateTime?)("OutDate", outDate.Value)
End If
End With
originalDataTable.Rows.Add (newRow)
End Sub
' Adding rows to the table.
addRow("type1", #2/2/2017#, Nothing)
addRow(Nothing, #1/25/2016#, Nothing)
addRow(Nothing, Nothing, #1/30/2016#)
' Copy the table
Dim copiedDataTable As DataTable = originalDataTable.Copy
' Loop through copied table rows.
For i As Integer = 0 To copiedDataTable.Rows.Count - 1
Dim type As String = copiedDataTable.Rows(i).Field(Of String)("Type")
Dim inDate As DateTime? = copiedDataTable.Rows(i).Field(Of DateTime?)("InDate")
Dim outDate As DateTime? = copiedDataTable.Rows(i).Field(Of DateTime?)("OutDate")
' Using DataTable Select.
Dim filter As String = String.Format("{0} {1} {2}",
If(type Is Nothing, "( Type Is Null )", String.Format("( Type = '{0}' )", type)),
If(Not inDate.HasValue, "And ( InDate Is Null )", String.Format("And ( InDate = '{0}' )", inDate.Value.ToString())),
If(Not outDate.HasValue, "And ( OutDate Is Null )", String.Format("And ( OutDate = '{0}' )", outDate.Value.ToString())))
Dim usingSelectRows As DataRow() = originalDataTable.Select(filter)
Console.WriteLine("usingSelectRows.Count = {0}", usingSelectRows.Count)
' Using Linq.
Dim typeSelector As Func(Of DataRow, Boolean) = Function(r)
If (IsNothing(type)) Then
Return IsNothing(r.Field(Of String)("Type"))
Else
Return r.Field(Of String)("Type") = type
End If
End Function
Dim inDateSelector As Func(Of DataRow, Boolean) = Function(r)
If (Not inDate.HasValue) Then
Return Not r.Field(Of DateTime?)("InDate").HasValue
Else
Return r.Field(Of DateTime?)("InDate").GetValueOrDefault.CompareTo(inDate.GetValueOrDefault) = 0
End If
End Function
Dim outDateSelector As Func(Of DataRow, Boolean) = Function(r)
If (Not outDate.HasValue) Then
Return Not r.Field(Of DateTime?)("OutDate").HasValue
Else
Return r.Field(Of DateTime?)("OutDate").GetValueOrDefault.CompareTo(outDate.GetValueOrDefault) = 0
End If
End Function
Dim usingLinqRows = From r In originalDataTable.AsEnumerable
Where
(typeSelector(r)) AndAlso
(inDateSelector(r)) AndAlso
(outDateSelector(r))
Select r
Console.WriteLine("usingLinqRows.Count = {0}", usingLinqRows.Count)
Console.WriteLine()
Next
Console.ReadLine()
End Sub
End Module
Always use the Field extension of DataRow to retrieve data.
Related
all. I am a new VB.NET beginner. I am facing the issue of how to pass the dynamic SQL parameter values from the dynamic textboxes to search the data. I had added control of dynamic textboxes and labels and would like to search the data on the database table based on the dynamic textboxes value inputted from the user. Currently, I can only able to search the data from 1 dynamic textbox value only.
I want all the values from the dynamic textboxes that the user had been entered can be retrieved, and search the data based on the SQL parameter variable name and value entered by the user.
Can someone give me some solutions on how to solve this problem? I had stuck on this problem for a few days. Thank you for all the help!
What I had tried:
Private Sub FilterData()
Dim count As Integer = 0
'filterdata for radiobutton
Try
For Each TextBox As TextBox In grp2.Controls.OfType(Of TextBox)()
For Each Label As Label In grp2.Controls.OfType(Of Label)()
Using connection As New SqlConnection("connectionString")
'user key in the SQL statement
sql = TextBox1.Text
Dim sql2 As String
sql2 = sql
Dim sp1 As String() = sql.Split(New String() {"where"}, StringSplitOptions.None)
sql = sp1(0) & " where " & Label.Text & " = #parameter or " & Label.Text & " =#parameter"
If (TextBox.Text <> "") Then
count += 1
For j As Integer = 0 To count - 1
Using cmd As New SqlCommand(sql, connection)
cmd.Parameters.AddWithValue("#parameter", TextBox.Text)
'cmd.Parameters.Add("#parameter", SqlDbType.NVarChar, 20).Value = TextBox.Text
connection.Open()
Dim dt As New DataTable()
Dim reader As SqlDataReader
reader = cmd.ExecuteReader()
dt.Load(reader)
DataGridView1.DataSource = dt
End Using
Next
Else
GetData()
End If
'cmd.Dispose()
connection.Close()
End Using
Next
Next
Catch ex As Exception
'MsgBox(ex.Message)
End Try
End Sub
Firstly, if you have a 1:1 correspondence between Labels and TextBoxes then you should not be using two nested For Each loops, because that is going to pair up each and every Label with each and every TextBox. What you should be doing is creating arrays and then using a single For loop to access the pairs of controls:
Dim labels = grp2.Controls.OfType(Of Label)().ToArray()
Dim textBoxes = grp2.Controls.OfType(Of TextBox)().ToArray()
For i = 0 To labels.getUpperBound(0)
Dim label = labels(i)
Dim textBox = textBoxes(i)
'...
Next
As for build the SQL and adding the parameters, I would tend to do it something like this:
Dim labels = grp2.Controls.OfType(Of Label)().ToArray()
Dim textBoxes = grp2.Controls.OfType(Of TextBox)().ToArray()
Dim criteria As New List(Of String)
Dim command As New SqlCommand
For i = 0 To labels.getUpperBound(0)
Dim label = labels(i)
Dim textBox = textBoxes(i)
Dim parameterName = "#" & label.Text.Replace(" ", "_")
criteria.Add($"[{label.Text}] = {parameterName}")
command.Parameters.AddWithValue(parameterName, textBox.Text)
Next
Dim sql = "SELECT * FROM MyTable"
If criteria.Any() Then
sql &= " WHERE " & String.Join(" OR ", criteria)
End If
command.CommandText = sql
I think that you should begin to separate UI and data logic here is an example of implementation:
First you have a table in database:
CREATE TABLE Customer (
Id INT IDENTITY (1, 1) PRIMARY KEY,
FirstName VARCHAR (255) NOT NULL,
LastName VARCHAR (255) NOT NULL,
Phone VARCHAR (25),
Email VARCHAR (255) NOT NULL,
Street VARCHAR (255),
City VARCHAR (50),
State VARCHAR (25),
ZipCode VARCHAR (5)
);
Then you create the underlying entity in VB. Net:
Public Class Customer
Public Property Id As Integer
Public Property FirstName As String
Public Property LastName As String
Public Property Phone As String
Public Property Email As String
Public Property Street As String
Public Property City As String
Public Property State As String
Public Property ZipCode As String
End Class
Data loader
Now you need a data access component that loads records to a list of this above entity here a nice implementation:
Imports System.Data.SqlClient
Public Class CustomerDataAccess
Public Property ConStr As String
Public Sub New(ByVal constr As String)
constr = constr
End Sub
Public Function GetCustomersByCriterias(constraints As Object) As List(Of Customer)
Dim query As String = "SELECT Id, FirstName, LastName, Phone, Email, Street, City, State, ZipCode
FROM [dbo].[Customer] "
Dim result = New List(Of Customer)()
Using con = New SqlConnection(ConStr)
Using cmd = con.CreateCommand()
cmd.CommandType = CommandType.Text
cmd.CommandText = query
'' here the magic to add dynamic criteria coming from constraints
cmd.ApplyConstraints(Of Customer)(constraints)
con.Open()
LoadCustomerData(cmd, result)
End Using
End Using
Return result
End Function
Private Sub LoadCustomerData(ByVal cmd As SqlCommand, ByVal result As List(Of Customer))
Using rdr = cmd.ExecuteReader()
Dim idIdx As Integer = rdr.GetOrdinal("Id")
Dim firstNameIdx As Integer = rdr.GetOrdinal("FirstName")
Dim lastNameIdx As Integer = rdr.GetOrdinal("LastName")
Dim phoneIdx As Integer = rdr.GetOrdinal("Phone")
Dim emailIdx As Integer = rdr.GetOrdinal("Email")
Dim streetIdx As Integer = rdr.GetOrdinal("Street")
Dim cityIdx As Integer = rdr.GetOrdinal("City")
Dim stateIdx As Integer = rdr.GetOrdinal("State")
Dim zipCodeIdx As Integer = rdr.GetOrdinal("ZipCode")
While rdr.Read()
Dim item = New Customer()
item.Id = rdr.GetValueOrDefault(Of Integer)(idIdx)
item.FirstName = rdr.GetValueOrDefault(Of String)(firstNameIdx)
item.LastName = rdr.GetValueOrDefault(Of String)(lastNameIdx)
item.Phone = rdr.GetValueOrDefault(Of String)(phoneIdx)
item.Email = rdr.GetValueOrDefault(Of String)(emailIdx)
item.Street = rdr.GetValueOrDefault(Of String)(streetIdx)
item.City = rdr.GetValueOrDefault(Of String)(cityIdx)
item.State = rdr.GetValueOrDefault(Of String)(stateIdx)
item.ZipCode = rdr.GetValueOrDefault(Of String)(zipCodeIdx)
result.Add(item)
End While
End Using
End Sub
End Class
Extensions methods
Below are extensions methods referenced above that do the magic you are looking for:
DataReader extensions to make it easy to read values from SalDataReader with Dbnull exfeptional case and casting
Module DataReaderExtenions
<Extension()>
Function GetValueOrDefault(Of T)(row As IDataRecord, fieldName As String) As T
Dim ordinal = row.GetOrdinal(fieldName)
Return row.GetValueOrDefault(Of T)(ordinal)
End Function
<Extension()>
Function GetValueOrDefault(Of T)(row As IDataRecord, ordinal As Integer) As T
Return (If(row.IsDBNull(ordinal), Nothing, row.GetValue(ordinal)))
End Function
<Extension()>
Function GetValueOrDefaultSqlite(Of T)(row As IDataRecord, fieldName As String) As T
Dim ordinal = row.GetOrdinal(fieldName)
Return row.GetValueOrDefault(Of T)(ordinal)
End Function
<Extension()>
Function GetValueOrDefaultSqlite(Of T)(row As IDataRecord, ordinal As Integer) As T
Return (If(row.IsDBNull(ordinal), Nothing, Convert.ChangeType(row.GetValue(ordinal), GetType(T))))
End Function
End Module
Command extensions that lets you extract criteria from an anonymous object values:
Imports System.Reflection
Imports System.Runtime.CompilerServices
Module CommandExtensions
<Extension()>
Function AddParameter(command As IDbCommand, name As String, value As Object) As IDataParameter
If command Is Nothing Then Throw New ArgumentNullException("command")
If name Is Nothing Then Throw New ArgumentNullException("name")
Dim p = command.CreateParameter()
p.ParameterName = name
p.Value = If(value, DBNull.Value)
command.Parameters.Add(p)
Return p
End Function
<Extension()>
Function ToDictionary(data As Object) As Dictionary(Of String, Object)
If TypeOf data Is String OrElse data.[GetType]().IsPrimitive Then Return New Dictionary(Of String, Object)()
Return (From [property] In data.[GetType]().GetProperties(BindingFlags.[Public] Or BindingFlags.Instance)
Where [property].CanRead
Select [property]).ToDictionary(Function([property]) [property].Name, Function([property]) [property].GetValue(data, Nothing))
End Function
<Extension()>
Sub ApplyConstraints(Of TEntity)(cmd As IDbCommand, constraints As Object)
If constraints Is Nothing Then Return
Dim dictionary = constraints.ToDictionary()
Dim whereClause = " WHERE "
For Each kvp In dictionary
Dim columnName = kvp.Key
Dim propertyName = kvp.Key
Dim prefix = "#"c
Dim value = kvp.Value
whereClause += $"{columnName} **like** {prefix}{propertyName} AND "
cmd.AddParameter(propertyName, value)
Next
If String.IsNullOrEmpty(whereClause) Then Return
cmd.CommandText += whereClause.Remove(whereClause.Length - 5, 5)
End Sub
End Module
Example:
After coded all these stuff now you can do the following:
Dim DataGridView1 As DataGridView = New DataGridView()
Dim ConStr As String = ConfigurationManager.ConnectionStrings("MyApp").ConnectionString
Dim dal As CustomerDataAccess = New CustomerDataAccess(ConStr)
Dim criterias = New With {.FirstName = "%James%", .LastName = "%Nadin%"}
DataGridView1.DataSource = dal.GetCustomersByCriterias(criterias)
Despite all this code you are still need to bind your textbox (after naming them correctly) to a SearchEntity and use this entity to provide criterias
I hope this material can help you tackle your issue and incite you to improve your architecture & dev skills
Thought the code would catch empty records but it turns out it has not been and no error.
turns out my function always returns FALSE
Try
conn.Open()
Dim strQuery As String = "Select * FROM [UsersDataTbl] " & _
"WHERE [UserName] = """ & UserName & """"
Dim comm As New Data.OleDb.OleDbCommand(strQuery, conn)
Dim reader As Data.OleDb.OleDbDataReader = comm.ExecuteReader()
While reader.Read()
If noNull(reader("StudentID") = "") _
Or noNull(reader("LastName") = "") _
Or noNull(reader("FirstName") = "") _
Or noNull(reader("Affiliation") = "") Then
BlankFields = True
Else
BlankFields = False
End If
End While
conn.Close()
Catch ex As Exception
ADDED:
found my noNull method:
Public Function noNull(ByRef o As Object) As String
If (o Is Nothing) Then
Return ""
End If
Return o.ToString()
End Function
I process recordfield values like this:
Dim iVal As Integer = NoNull(r.Fields("someintegerfield").Value, "0", False)
Public Function NoNull(ByVal uAny As Object, Optional ByVal uFillString As String = "", Optional ByVal uTreatDecimalNullAsNothing As Boolean = False) As String
Dim sRet As String = String.Empty
If Not Convert.IsDBNull(uAny) AndAlso Not uAny Is Nothing Then
Debug.Assert(uAny.GetType.ToString <> "cField") 'checking if the argument is a "cField" helps me to check whether I passes "r.fields("somefield").value to this function, or if I forgot the ".value")
sRet = uAny
Else
sRet = String.Empty
End If
If StrLen(sRet) = 0 Then
If modStrings.StrLen(uFillString) > 0 Then
sRet = uFillString
End If
End If
If uTreatDecimalNullAsNothing Then
If sRet = "0" Then
sRet = uFillString
End If
End If
Return sRet
End Function
Public Function StrLen(ByVal uString As String) As Integer
If (Not uString Is Nothing) AndAlso (Not uString = "") Then
Return uString.Length
Else
Return 0
End If
End Function
I hope this can help you.
Dim con As New System.Data.OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=H:\yourDB.accdb;")
Dim cb As String = "SELECT * FROM Table1 "
Dim dr As System.Data.OleDb.OleDbDataReader
Dim cmd As New System.Data.OleDb.OleDbCommand
cmd.Connection = con
cmd.CommandText = cb
con.Open()
dr = cmd.ExecuteReader
While dr.Read()
If Not IsDBNull(dr("value1")) Then MessageBox.Show(dr("value1"))
End While
con.Close()
Supposing that the noNull method is something like this
Public Function noNull(dbValue As Object) as Boolean
if dbValue = DBNull.Value OrElse dbValue = "" Then
return True
else
return False
End If
End Function
Then you call it with
....
noNull(reader("LastName") = "")
....
This means that you compare the value of the LastName field to an Empty string and the result is a boolean True or False, but passing a Boolean value to noNull means that it will never be equal to an empty string or to a DBNull.Value and thus it will return always false
You need to call the method with
If noNull(reader("StudentID")) _
Or noNull(reader("LastName")) _
Or noNull(reader("FirstName")) _
Or noNull(reader("Affiliation")) Then
Or without the noNull method
If reader.IsDBNull(reader.GetOrdinal("StudentID")) _
OrElse reader("StudentID") = "" _
OrElse reader.IsDBNull(reader.GetOrdinal("LastName")) _
OrElse reader("LastName") = ""
OrElse reader.IsDBNull(reader.GetOrdinal("FirstName")) _
OrElse reader("FirstName") = "" _
OrElse reader.IsDBNull(reader.GetOrdinal("Affiliation")) _
OrElse reader("Affiliation") = "" Then
BlankFields = True
Else
BlankFields = False
End If
As you can see this is really ugly, so I suppose that a method like noNull iomplemented above could be useful in this context
EDIT Now, looking at the code of your noNull method then it is clear where is the error.
You should just change the parenthesis position.
If noNull(reader("StudentID")) = "" _
Or noNull(reader("LastName")) = "" _
Or noNull(reader("FirstName")) = "" _
Or noNull(reader("Affiliation")) = "" Then
I want to come up with this problem.... if there's only 1 false in loop then it will not insert into database and vise versa if all true then it will insert to database.
Here's is my code
Public Function Check_Foreign_Key(ByVal select_column_name As String, ByVal table_name As String, ByVal where_column_name As String, ByVal where_value As String, ByRef Foreign_Key As String) As Boolean
Dim dt_service_provider_id As DataTable = ExecuteSQLQuery("select " & select_column_name & " from " & table_name & " where " & where_column_name & " = '" & where_value & "'")
If dt_service_provider_id.Rows.Count = 0 Then
Return False
Else
Foreign_Key = dt_service_provider_id.Rows(0).Item(0).ToString()
Return True
End If
End Function
For Each dr As DataRow In dt.Rows
Dim dt_rows as Integer = 0
Dim site_id As Boolean = Check_Foreign_Key("site_id", "sites", "site_code", dr(2).ToString, dt_fk)
If dr(0).ToString.Length > 50 And dr(0).ToString = "" And dr(0).ToString Is Nothing Then
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, "Character is greater than 50")
'in here i want to continue checking go to next, i think i got error in cheking if dr(0) is empty
Else
If dr(1).ToString.Length > 50 And dr(1).ToString = "" And dr(1).ToString Is Nothing Then
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, "Character is greater than 50")
'in here i want to continue again to next
Else
Select Case site_id
Case False
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, dr(2).ToString)
Return
End Select
End If
End If
dt_row += 1
Next
THis is the code i only i know but unfortunately i cannot get my logic it always inserting rather it have 1 false
Hope this solve the problem
Dim blnAllTrue As Boolean = True
For Each dr As DataRow In dt.Rows
Dim site_id As Boolean = Check_Foreign_Key("site_id", "sites", "site_code", dr(2).ToString, dt_fk)
blnAllTrue = blnAllTrue And site_id
If site_id = False Then
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, dr(2).ToString)
End If
Next
If blnAllTrue = True Then
'insert into your database
End If
Try this
Private SaveToDB()
For Each dr As DataRow In dt.Rows
Dim site_id As Boolean = Check_Foreign_Key("site_id", "sites", "site_code", dr(2).ToString, dt_fk)
Select Case site_id
Case False
get_error(dt.TableName, dt.Columns(2).ToString, dt_row.ToString, dr(2).ToString)
Return
End Select
Next
'if you got here means no error
'NOTE: You should loop again and save the rows
For Each dr As DataRow In dt.Rows
'Your code to save into the database here
Next
End Sub
I am hopeing someone can help me here with a recursive function I have that is not returning either true or false as I would have espected it to. The function loops through a Active Directory group for its members and then calls itself if it encounters any groups within the membership in order to gets its members as well. I am trying to return either true or false based on if any errors were encountered but not haveing any luck at all. It appears to just hang and never return back to the primary calling sub that starts the recursive function. Below is my code I am using:
Private Sub StartAnalysis(ByVal grp As String, ByVal grpdn As String, ByVal reqid As String)
Dim searchedGroups As New Hashtable
'prior work before calling sub
searchedGroups.Add(grp, 1)
Dim iserror As Boolean = GetGroupMembers(grpdn, searchedGroups, reqid)
If iserror = False Then
'do stuff
Else
'do stuff
End If
'cleanup
End Sub
Public Function GetGroupMembers(ByVal groupSearch As String, ByVal searchedGroups As Hashtable, ByVal requestID As String) As Boolean
Dim iserror As Boolean = False
Try
Dim lastQuery As Boolean = False
Dim endLoop As Boolean = False
Dim rangeStep As Integer = 999
Dim rangeLow As Integer = 0
Dim rangeHigh As Integer = rangeLow + rangeStep
Do
Dim range As String = "member"
If lastQuery = False Then
range = String.Format("member;range={0}-{1}", rangeLow, rangeHigh)
Else
range = String.Format("member;range={0}-*", rangeLow)
endLoop = True
End If
Dim group As SearchResult = QueryObject(groupSearch, range)
Dim groupCN As String = group.Properties("cn")(0).ToString
If group.Properties.Contains(range) Then
For Each member As Object In group.Properties(range)
Dim user As SearchResult = QueryObject(member.ToString, "member")
Dim userCN = user.Properties("cn")(0).ToString
If Not user.Properties.Contains("member") Then
Dim userMail = String.Empty
If user.Properties.Contains("mail") Then
userMail = user.Properties("mail")(0).ToString
End If
userCN = userCN.Replace("'", "''")
Dim qry As String = _
"INSERT INTO group_analysis_details (request_id, member_name, member_email, member_group) " & _
"values ('" & requestID & "', '" & userCN & "', '" & userMail & "', '" & groupCN & "')"
Dim sqlConn As SqlConnection = New SqlConnection(cs)
Dim sqlCmd As SqlCommand = New SqlCommand(qry, sqlConn)
sqlConn.Open()
sqlCmd.ExecuteNonQuery()
sqlConn.Close()
sqlCmd.Dispose()
sqlConn.Dispose()
Else
If Not searchedGroups.ContainsKey(userCN) Then
searchedGroups.Add(userCN, 1)
iserror = GetGroupMembers(user.Properties("distinguishedname")(0).ToString, searchedGroups, requestID)
If iserror = True Then Return iserror
Else
searchedGroups(userCN) += 1
End If
End If
Next
Else
lastQuery = True
End If
If lastQuery = False Then
rangeLow = rangeHigh + 1
rangeHigh = rangeLow + rangeStep
End If
Loop While endLoop = False
Return iserror
Catch ex As Exception
myEvents.WriteEntry("Error while analyzing the following group: " & groupSearch & vbCrLf & vbCrLf & _
"Details of the error are as follows: " & ex.Message, EventLogEntryType.Error)
Return True
End Try
End Function
Hopefully someone can point out where I might be making my error is this.
Thanks,
Ron
Generally if you're using a 'Do...Loop While' and manually setting the exit condition inside the loop it's very easy to get stuck in an infinite loop which is what causes the program to hang.
It looks like you're not setting endloop = True in all circumstances. Try changing it to an Exit Do and adding one to each of the various conditions you have. A bit of trial and error will be required to get it just right.
Also to make your life easier extract the database insert code into a seperate function and call it when needed.
I have a xls file, or a csv without quotes, and using vb.net need to turn it into a csv with quotes around every cell. If I open the xls/csv without quotes in MS Access, set every column to text and then export it, its in the format I need. Is there an easier way? If not, how do I do replicate this in vb.net? Thanks.
If you use the .Net OLE DB provider, you can specify the .csv formatting details in a schema.ini file in the folder your data files live in. For the 'unquoted' .csv the specs
should look like
[noquotes.csv] <-- file name
ColNameHeader=True <-- or False
CharacterSet=1252 <-- your encoding
Format=Delimited(,) <--
TextDelimiter= <-- important: no " in source file
Col1=VendorID Integer <-- your columns, of course
Col2=AccountNumber Char Width 15
for the 'quoted' .csv, just change the name and delete the TextDelimiter= line (put quotes around text fields is the default).
Then connect to the Text Database and execute the statement
SELECT * INTO [quotes.csv] FROM [noquotes.csv]
(as this creates quotes.csv, you may want to delete the file before each experimental run)
Added to deal with "Empty fields must be quoted"
This is a VBScript demo, but as the important things are the parameters for .GetString(), you'll can port it to VB easily:
Dim sDir : sDir = resolvePath( "§LibDir§testdata\txt" )
Dim sSrc : sSrc = "noquotes.csv"
Dim sSQL : sSQL = "SELECT * FROM [" & sSrc & "]"
Dim oTxtDb : Set oTxtDb = New cADBC.openDb( Array( "jettxt", sDir ) )
WScript.Echo goFS.OpenTextFile( goFS.BuildPath( sDir, sSrc ) ).ReadAll()
Dim sAll : sAll = oTxtDb.GetSelectFRO( sSQL ).GetString( _
adClipString, , """,""", """" & vbCrlf & """", "" _
)
WScript.Echo """" & Left( sAll, Len( sAll ) - 1 )
and output:
VendorID;AccountNumber;SomethingElse
1;ABC 123 QQQ;1,2
2;IJK 654 ZZZ;2,3
3;;3,4
"1","ABC 123 QQQ","1,2"
"2","IJK 654 ZZZ","2,3"
"3","","3,4"
(german locale, therefore field separator ; and decimal symbol ,)
Same output from this VB.Net code:
Imports ADODB
...
Sub useGetString()
Console.WriteLine("useGetString")
Const adClipString As Integer = 2
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim sAll As String
cn.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=M:\lib\kurs0705\testdata\txt\;" _
& "Extended Properties=""text;"""
cn.Open()
rs = cn.Execute("SELECT * FROM [noquotes.csv]")
sAll = rs.GetString( adClipString, , """,""", """" & vbCrLf & """", "" )
cn.Close()
sAll = """" & Left( sAll, Len( sAll ) - 1 )
Console.WriteLine( sAll )
End Sub
Check out the method at this link.
What you can do to make sure quotes go around is append quotes to the beginning and end of each column data in the loop that is putting the column data in the file.
for example make the loop like this:
For InnerCount = 0 To ColumnCount - 1
Str &= """" & DS.Tables(0).Rows(OuterCount).Item(InnerCount) & ""","
Next
Public Class clsTest
Public Sub Test
Dim s as string = "C:\!Data\Test1.csv"
Dim Contents As String = System.IO.File.ReadAllText(s)
Dim aryLines As String() = Contents.Split(New String() { Environment.Newline }, StringSplitOptions.None)
Dim aryParts() As String
Dim aryHeader() As String
Dim dt As System.Data.DataTable
For i As Integer = 0 To aryLines.Length - 1
aryParts = SplitCSVLine(aryLines(i))
If dt Is Nothing And aryHeader Is Nothing Then
aryHeader = CType(aryParts.Clone, String())
ElseIf dt Is Nothing And aryHeader IsNot Nothing Then
dt = DTFromStringArray(aryParts, 1000, "", aryHeader)
Else
DTAddStringArray(dt, aryParts)
End If
Next
dt.dump
End Sub
Public Shared Function SplitCSVLine(strCSVQuotedLine As String) As String()
Dim aryLines As String() = strCSVQuotedLine.Split(New String() {Environment.NewLine}, StringSplitOptions.None)
Dim aryParts As String() = Nothing
For i As Integer = 0 To aryLines.Length - 1
Dim regx As New Text.RegularExpressions.Regex(",(?=(?:[^\""]*\""[^\""]*\"")*(?![^\""]*\""))")
aryParts = regx.Split(aryLines(i))
For p As Integer = 0 To aryParts.Length - 1
aryParts(p) = aryParts(p).Trim(" "c, """"c)
Next
Next
Return aryParts
End Function
Public Shared Function DTFromStringArray(ByVal aryValues() As String, Optional ByVal intDefaultColumnWidth As Integer = 255, Optional ByVal strTableName As String = "tblArray", Optional ByVal aryColumnNames() As String = Nothing) As DataTable
If String.IsNullOrWhiteSpace(strTableName) Then strTableName = "tblArray"
Dim dt As DataTable = New DataTable(strTableName)
Dim colNew(aryValues.GetUpperBound(0)) As DataColumn
If aryColumnNames Is Nothing Then
ReDim aryColumnNames(aryValues.Length)
Else
If aryColumnNames.GetUpperBound(0) < aryValues.GetUpperBound(0) Then
ReDim Preserve aryColumnNames(aryValues.Length)
End If
End If
For x As Integer = aryColumnNames.GetLowerBound(0) To aryColumnNames.GetUpperBound(0)
If String.IsNullOrWhiteSpace(aryColumnNames(x)) Then
aryColumnNames(x) = "Field" & x.ToString
Else
aryColumnNames(x) = aryColumnNames(x)
End If
Next
For i As Integer = 0 To aryValues.GetUpperBound(0)
colNew(i) = New DataColumn
With colNew(i)
.ColumnName = aryColumnNames(i) '"Value " & i
.DataType = GetType(String)
.AllowDBNull = False
.DefaultValue = ""
.MaxLength = intDefaultColumnWidth
.Unique = False
End With
Next
dt.Columns.AddRange(colNew)
Dim pRow As DataRow = dt.NewRow
For i As Integer = aryValues.GetLowerBound(0) To aryValues.GetUpperBound(0)
pRow.Item(i) = aryValues(i)
Next
dt.Rows.Add(pRow)
Return dt
End Function
Public Shared Sub DTAddStringArray(ByRef dt As DataTable, ByVal aryRowValues() As String)
Dim pRow As DataRow
pRow = dt.NewRow
For i As Integer = aryRowValues.GetLowerBound(0) To aryRowValues.GetUpperBound(0)
pRow.Item(i) = aryRowValues(i)
Next
dt.Rows.Add(pRow)
End Sub
End Class