I have the following code to split strings in arrays and then instert the arrays into database
Private Sub ReadAllModules()
Dim list As String() = rtbComData.Text.Split(Environment.NewLine.ToCharArray())
For Each Row As String In list
If Not (Row = "AT+BC=FL " + dtp_Rinterval.Value.ToString("dd/MM/yyyy") + "" Or Row = "OK" Or Row = "") Then
Try
Dim separator As String() = {"+", "|", "*"}
Dim s = Row.Split(separator, StringSplitOptions.RemoveEmptyEntries)
Dim con As New SqlConnection
Dim cmd As New SqlCommand
con.ConnectionString = "Data Source=.\SQLEXPRESS;AttachDbFilename=|DataDirectory|\Database\smdData.mdf;Integrated Security=True;User Instance=True"
con.Open()
cmd.Connection = con
cmd.CommandText = "UPDATE smdTable SET date='" + s(1) + "',datetime='" + s(2) + "',Interval1='" + s(3) + "',vi1='" + s(4) + "',Interval2='" + s(5) + "',vi2='" + s(6) + "',Interval3='" + s(7) + "' WHERE AdresaUnica= '" + s(0) + "'"
cmd.ExecuteNonQuery()
Me.SmdTableTableAdapter.Fill(Me.SmdDataDataSet1.smdTable)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End If
Next
End Sub
Until now I had the strings coming on a single line and that was ok. However now my strings comes on different lines like:
AT+BC=FL 09/09/2015
OK
+00019500000068B9|1:9/9/2015|06:55:18|19:30-22:30*100|22:30-00:30*80|00:30- 05:00*40|05:00-
+00019500000068B9|2:07:30*90|OFF
how do I insert the second line string in an array and insert it in the database?
Related
I have a excel workbook that pulls data into a table users can then fill in the missing dates in column 11. Column 1 is the unique identifier that matches the ID column in the SQL table. I want to create a macro that runs when the workbook is closed and will update the SQL table with the filled in dates, but I am struggling with the code. I have have tried two different things but neither seem to work.
Option 1:
Private Sub tableupdate()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim i As Long
Dim vDB As Variant
Dim ws As Worksheet
con.connectionstring = "Provider=SQLOLEDB;Password=*********;User ID=clx_write; Initial Catalog=DPEDataMartDBPrd01; Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"
con.Open
Set cmd.ActiveConnection = con
Set ws = ActiveSheet
vDB = ws.Range("A4").CurrentRegion
For i = 2 To UBound(vDB, 1)
cmd.CommandText = "UPDATE [dbo].[all_load_control] set Driver_arr_dte = ' " & vDB(i, 2) & " ' WHERE mst_ship_num = ' " & vDB(i, 1) & " ' "
cmd.Execute
Next i
con.Close
Set con = Nothing
End Sub
option 2:
Private Sub uplodblanks()
Dim r, c, con, dstring
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim lRow
Dim ssql As String
con = "Provider=SQLOLEDB;Password=********;User ID=clx_write; Initial Catalog=DPEDataMartDBPrd01; Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"
r = 1
c = 1
Worksheets("WTUpload").Calculate
lRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
cn.Open con
i = 1
For i = 1 To lRow
ssql = "update dbo.cxu_all_load_control set driver_arr_dte = " & CDate(Sheets("WTUpload").Cells(i, 11)) & " where mst_ship_num = " & CDbl(Sheets("WTUpload").Cells(i, 11)) & " ; "
cn.Execute ssql
Next i
cn.Close
End Sub
Any help as to why neither of these are working would be great
Replace the mydbConnect() function with you own method of getting a connection.
Sub tableupdate2()
Const COL_NUM As String = "A"
Const COL_DATE As String = "K"
Const TABLE As String = "dbo.all_load_control"
' define update sql
Const SQL As String = " UPDATE " & TABLE & _
" SET Driver_arr_dte = CAST(? AS DATETIME2) " & _
" WHERE mst_ship_num = ? "
' establish connection and create command object
Dim con As Object, cmd As Object, sSQL As String
Set con = mydbConnect() ' establish connection
Set cmd = CreateObject("ADODB.Command")
With cmd
.ActiveConnection = con
.CommandText = SQL
.CommandType = 1 'adCmdText
.Parameters.Append .CreateParameter("P1", adVarChar, 1, 20) '
.Parameters.Append .CreateParameter("P2", adVarChar, 1, 50) ' adParamInput = 1
End With
' prepare to get data from spreadsheet
Dim wb As Workbook, ws As Worksheet, iLast As Integer, iRow As Integer
Set wb = ThisWorkbook
Set ws = wb.Sheets("WTUpload")
iLast = ws.Range(COL_NUM & Rows.count).End(xlUp).Row
Dim p1 As String, p2 As String, count As Long
' scan sheet and update db
Debug.Print "Updates " & Now
With cmd
For iRow = 1 To iLast
p1 = Format(ws.Range(COL_DATE & iRow).Value, "yyyy-mm-dd hh:mm")
p2 = ws.Range(COL_NUM & iRow).Value
If len(p2) > 0 Then
.Parameters(0).Value = p1
.Parameters(1).Value = p2
Debug.Print "Row ", iRow, "p1=" & p1, "P2=" & p2
.Execute
count = count + 1
End If
Next
End With
' end
MsgBox "Rows processed = " & count, vbInformation, "Updates Complete"
con.Close
Set con = Nothing
End Sub
Edit - added connection and test code
Function mydbConnect() As Object
Dim sConStr As String
sConStr = "Provider=SQLOLEDB;Password=*********;User ID=clx_write;" & _
"Initial Catalog=DPEDataMartDBPrd01;" & _
"Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"
Set mydbConnect = CreateObject("ADODB.Connection")
mydbConnect.Open sConStr
End Function
Sub test()
Dim con As Object, rs As Object
Set con = mydbConnect()
Set rs = con.Execute("SELECT CURRENT_TIMESTAMP")
MsgBox rs.Fields(0), vbInformation, "Current Date/Time"
End Sub
I have an unsecured query which allows for an injection, and I'm not sure how to go about parameterizing it to prevent said injection
Dim sInsertSQL As String
sInsertSQL = "Insert into tbl_userprop (Prop_Def) values "
Dim tempString As String() = PropertyDefinitions.Split("|")
For i As Integer = 1 To tempString.Length
If tempString(i - 1).Length > 0 Then
sInsertSQL = sInsertSQL + " ('" + tempString(i - 1) + "'),"
bInsert = True
End If
Next
There are up to 10 values stored in tempString and they are concatenated onto sInsertSQL as such: ('val1'), ('val2'), etc
Figured it out, update for the curious:
Dim lstParams As New Collections.Generic.List(Of SqlParameter)
Dim tempString As String() = PropertyDefinitions.Split("|")
For i As Integer = 1 To tempString.Length
If tempString(i - 1).Length > 0 Then
Dim sParamName As String = String.Format("#param{0}", i)
Dim sparam As New SqlParameter(sParamName, tempString(i - 1))
lstParams.Add(sparam)
sInsertSQL = sInsertSQL + " (" + sParamName + "),"
bInsert = True
End If
Next
Once you have split the string you know how many parameters there will be, so you can create the # items for the SQL. After that, you can add the parameters by going through the lists of parameter names and values:
Dim PropertyDefinitions = "abc|def|ghi|jkl|mno"
Dim values = PropertyDefinitions.Split({"|"c})
Dim paramNames = Enumerable.Range(0, values.Count()).Select(Function(n) $"#p{n}")
Dim paramList = String.Join(", ", paramNames.Select(Function(s) $"({s})"))
Dim sql = "INSERT INTO [tbl_userprop] (Prop_Def) VALUES " & paramList
' The following line with the sample data would output '
' INSERT INTO [tbl_userprop] (Prop_Def) VALUES (#p0), (#p1), (#p2), (#p3), (#p4)
'Console.WriteLine(sql)
Dim connStr = "YourConnectionStringHere"
Using conn As New SqlConnection(connStr)
Using cmd As New SqlCommand(sql, conn)
For i = 0 To values.Count() - 1
'TODO: Set the .SqlDbType and .Size to conform to the database definition of [tbl_userprop]. '
cmd.Parameters.Add(New SqlParameter With {.ParameterName = paramNames(i),
.Value = values(i),
.SqlDbType = SqlDbType.NVarChar,
.Size = 99})
Next
'conn.Open()
'cmd.ExecuteNonQuery()
End Using
End Using
This may have been asked and answered several times, but I have been unable to find the answer.
In CbProdukt1_SelectedIndexChanged(), I need the associated value from an array from another sub:
Private Sub CbProdukt1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles CbProdukt1.SelectedIndexChanged
With Me.LblEnhed1
.Text = Enhed(CbProdukt1.SelectedIndex)
.Location = New Point(230, 150)
End With
Me.Controls.Add(LblEnhed1)
End Sub
This would be easy enough if Enhed() had been public. But it is not as it is dimensioned and retrieved from Sqlite in another sub:
Dim count As Integer
sql = "SELECT COUNT(varenr) AS varenrcount FROM '" & Varedatabase & "'"
cmd = New SQLiteCommand(sql, conn)
count = cmd.ExecuteScalar
sql = "SELECT * FROM '" & Varedatabase & "'"
cmd = New SQLiteCommand(sql, conn)
reader = cmd.ExecuteReader
Dim a = 0
Dim Varenr(count + 5) As String
Dim Varenavn(count + 5) As String
Dim Enhed(count + 5) As String
While (reader.Read())
Varenr(a) = reader("varenr")
Varenavn(a) = reader("Varenavn")
Enhed(a) = reader("Enhed")
CbProdukt1.Items.Add(varenavn(a))
a += 1
End While
Public declarations are only allowed prior to subs at the top of the class.
So how do I get the Enhed(a) from sub to sub?
If there is a change of data in one tab on a page we need to see the update if the user changes something and moves to another tab...
This works perfectly with a Grid
Private Async Sub Telephone_ReturnData()
Try
Dim DGV As CustomControl.DGVx = Prospect_Grid.FindName("Telephone_DGV")
strSQL = "SELECT Prospect_TelephoneCalls.Transaction_ID as 'ID', "
strSQL += "Prospect_Contacts.Contact_FirstName + ' ' + Prospect_Contacts.Contact_Surname as 'Contact', "
strSQL += "Prospect_TelephoneCalls.Call_Date as 'Date' "
strSQL += "FROM Prospect_TelephoneCalls "
strSQL += "JOIN Prospect_Contacts ON Prospect_TelephoneCalls.Contact_ID = Prospect_Contacts.Contact_ID "
strSQL += "WHERE Prospect_TelephoneCalls.Prospect_ID = " & Prospect_ID
strSQL += " ORDER BY Prospect_TelephoneCalls.Call_Date DESC"
Await Task.Run(Sub()
Using vService As New Service1Client
Using DS As DataSet = vService.ReturnDataSetHAS(strSQL)
TelephoneDT = DS.Tables(0).Copy
End Using
End Using
End Sub)
DGV_ColumnDefinitions(DGV, TelephoneDT)
DGV.ItemsSource = TelephoneDT.DefaultView
Dim vRecords As Integer = TelephoneDT.Rows.Count
Dim vOutput As String = "One record returned..."
If Not vRecords = 1 Then
vOutput = vRecords & " records returned..."
End If
PageStatusBarLoaded(Prospect_Grid, vOutput)
Catch ex As Exception
EmailError(ex)
End Try
End Sub
End Region
But do the same thing with a ComboBox is goes into and endless loop and the app freezes.
Private Async Sub ReloadTelephoneContacts()
Try
'If TelephoneContactsDT Is Nothing Then
' TelephoneContactsDT = New DataTable
'Else
' TelephoneContactsDT.Dispose()
' TelephoneContactsDT = New DataTable
'End If
'' Dim DT As New DataTable
'With TelephoneContactsDT.Columns
' .Add("ID", GetType(Integer))
' .Add("Name", GetType(String))
'End With
'With TelephoneContactsDT.Rows
' .Add(0, "Select Contact")
'End With
Await Task.Run(Sub()
strSQL = "Select Contact_ID as 'ID', Contact_FirstName + ' ' + Contact_Surname as 'Name' FROM Prospect_Contacts WHERE Prospect_ID = " & Prospect_ID
Using vService As New Service1Client
Using DS As DataSet = vService.ReturnDataSetHAS(strSQL)
TelephoneContactsDT = DS.Tables(0).Copy
'For Each Row As DataRow In DS.Tables(0).Rows
' With TelephoneContactsDT.Rows
' .Add(Row("ID"), ReturnText(Row("Name")))
' End With
'Next
End Using
End Using
End Sub)
Dim SpokeToCB As CustomControl.ComboCBx = Prospect_Grid.FindName("Telephone_SpokeToCB")
'SpokeToCB.ItemsSource = Nothing
With SpokeToCB
.ItemsSource = TelephoneContactsDT.DefaultView
.DisplayMemberPath = "Name"
.SelectedValuePath = "ID"
.SelectedIndex = 0
End With
PageStatusBarRightChangeText(Prospect_Grid, "Telephone text")
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Any idea how I can overcome this?
It works perfectly if run during initialised but needs to be updated
Thanks
Moving the reload sub to the end of the adding the new contact sub did the trick. Apart from anything else selecting a new value from any ComboBox causes the TabController.SelectionChanged event to fire each time
Hi friends i am working on export excel rows to Sql Server 2008 Table
in that way i am checking the row already exist in table or not
my table has
sap_code
depot
size
entry_date
if table exist that record skip that row and check next row of excel with table
here goes my working code
' ===== Export Using ADO =====
Function ExportRangeToSQL(ByVal sourceRange As Range, _
ByVal conString As String, ByVal table As String) As Integer
On Error Resume Next
' Object type and CreateObject function are used instead of ADODB.Connection,
' ADODB.Command for late binding without reference to
' Microsoft ActiveX Data Objects 2.x Library
' ADO API Reference
' http://msdn.microsoft.com/en-us/library/ms678086(v=VS.85).aspx
' Dim con As ADODB.Connection
Dim con As Object
Set con = CreateObject("ADODB.Connection")
con.ConnectionString = conString
con.Open
' Dim cmd As ADODB.Command
Dim cmd As Object
Set cmd = CreateObject("ADODB.Command")
cmd.CommandType = 1 ' adCmdText
' Dim rst As ADODB.Recordset
Dim rst As Object
Set rst = CreateObject("ADODB.Recordset")
With rst
Set .ActiveConnection = con
.Source = "SELECT * FROM " & table
.CursorLocation = 3 ' adUseClient
.LockType = 4 ' adLockBatchOptimistic
.CursorType = 1 ' adOpenKeyset
.CursorType = 0 ' adOpenForwardOnly
.Open
' Do While Not .EOF
' .MoveNext
' Loop
' Column Mappings
Dim tableFields(100) As Integer
Dim rangeFields(100) As Integer
Dim exportFieldsCount As Integer
exportFieldsCount = 0
Dim col As Integer
Dim index As Integer
For col = 1 To .Fields.Count - 1
index = Application.Match(.Fields(col).Name, sourceRange.Rows(1), 0)
If index > 0 Then
exportFieldsCount = exportFieldsCount + 1
tableFields(exportFieldsCount) = col
rangeFields(exportFieldsCount) = index
End If
Next
If exportFieldsCount = 0 Then
ExportRangeToSQL = 1
Exit Function
End If
' Fast read of Excel range values to an array
' for further fast work with the array
Dim arr As Variant
arr = sourceRange.Value
' Column names should be equal
' For col = 1 To exportFieldsCount
' Debug.Print .Fields(tableFields(col)).Name & " = " & arr(1, rangeFields(col))
' Next
' The range data transfer to the Recordset
Dim row As Long
Dim rowCount As Long
rowCount = UBound(arr, 1)
Dim val As Variant
For row = 2 To rowCount
' Testing the Ledger data to insert
Dim qu As String
Dim br, de, si, da As String
br = arr(row, rangeFields(1)) ' sap_code from excel
de = arr(row, rangeFields(2)) ' depot from excel
si = arr(row, rangeFields(3)) ' size from excel
da = arr(row, rangeFields(5)) ' entry_date from excel
Set con = CreateObject("ADODB.Connection")
con.ConnectionString = conString
con.Open
Dim rstTest As ADODB.Recordset
Set rstTest = New ADODB.Recordset
With rstTest
.CursorLocation = adUseClient
.Open "select TOP 1 sap_code, depot, size, entry_date from openstock where " + "sap_code='" + br + "' and depot='" + de + "' and size='" + si + "' and entry_date='" + da + "' ORDER BY id DESC", con, adOpenStatic, adLockBatchOptimistic, adCmdText
MsgBox "SAP_CODE" & br & "Depot" & de & "Size" & si & "entry_date" & da & "Duplicate Entry Not Entered into Database"
If br = rstTest.Fields("sap_code").Value And _
de = rstTest.Fields("depot").Value And _
si = rstTest.Fields("size").Value And _
da = rstTest.Fields("entry_date").Value Then
Else
End With **NOte: Error showing here as End With with out With**
.AddNew
For col = 1 To exportFieldsCount
val = arr(row, rangeFields(col))
If IsEmpty(val) Then
Else
.Fields(tableFields(col)) = val
End If
Next
End If
Next **NOte: Problem showing here as Next with out FOR**
.UpdateBatch
End With
rst.Close
Set rst = Nothing
con.Close
Set con = Nothing
ExportRangeToSQL = 0
End Function
Suggestion: Always indent your code. So even if you look at the code say 6 months down the line, you will know what the code does. Indentation also helps you catch errors which occur as it happened in the code above
Here is an example
Sub Sample()
For i = 1 to 5
For j = 1 to 10
For k = 1 to 7
If a = 10 then
End If
Next
Next
Next
End Sub
The same code can be written as
Sub Sample()
For i = 1 to 5
For j = 1 to 10
For k = 1 to 7
If a = 10 then
End If
Next
Next
Next
End Sub
Another suggestion (it is not mandatory though) For a better understanding where does a For loop ends, it is advisable to write Next as say Next i.
So the above code can be further improved to
Sub Sample()
For i = 1 to 5
For j = 1 to 10
For k = 1 to 7
If a = 10 then
End If
Next k
Next j
Next i
End Sub
If you implement the above suggestion, you will notice that this section of your code
With rstTest
.CursorLocation = adUseClient
.Open "select TOP 1 sap_code, depot, size, entry_date from openstock where " + "sap_code='" + br + "' and depot='" + de + "' and size='" + si + "' and entry_date='" + da + "' ORDER BY id DESC", con, adOpenStatic, adLockBatchOptimistic, adCmdText
MsgBox "SAP_CODE" & br & "Depot" & de & "Size" & si & "entry_date" & da & "Duplicate Entry Not Entered into Database"
If br = rstTest.Fields("sap_code").Value And _
de = rstTest.Fields("depot").Value And _
si = rstTest.Fields("size").Value And _
da = rstTest.Fields("entry_date").Value Then
Else
End With **NOte: Error showing here as End With with out With**
.AddNew
For col = 1 To exportFieldsCount
val = arr(row, rangeFields(col))
If IsEmpty(val) Then
Else
.Fields(tableFields(col)) = val
End If
Next
End If
Next **NOte: Problem showing here as Next with out FOR**
Solution: Above code can be re-written as
For row = 2 To rowCount
'
'
'
With rstTest
.CursorLocation = adUseClient
.Open "select TOP 1 sap_code, depot, size, entry_date from openstock where " + _
"sap_code='" + br + "' and depot='" + de + "' and size='" + si + _
"' and entry_date='" + da + "' ORDER BY id DESC", con, adOpenStatic, _
adLockBatchOptimistic, adCmdText
MsgBox "SAP_CODE" & br & "Depot" & de & "Size" & si & "entry_date" & da & _
"Duplicate Entry Not Entered into Database"
If br = rstTest.Fields("sap_code").Value And _
de = rstTest.Fields("depot").Value And _
si = rstTest.Fields("size").Value And _
da = rstTest.Fields("entry_date").Value Then
Else
'~~> Removed End With from here
'End With **NOte: Error showing here as End With with out With**
.AddNew
For col = 1 To exportFieldsCount
val = arr(row, rangeFields(col))
If IsEmpty(val) Then
Else
.Fields(tableFields(col)) = val
End If
Next col
End If
End With '<~~ Pasted it here
Next row