I'm using VBA for working with SQL database, Select commands forking fine, problem is with modification of dbase - insert, delete. If I using external application for work with DBase, everything is OK, thats mean - my privilegs is OK. On example Select is done successfully, rest not...
Thanks for your help.
JB
Public LinkID As ADODB.Connection
Public QueryID As ADODB.Recordset
Private Record() As String
Public Row As Long
Public NumRows As Long
Public Function connect(Optional server As String = "", Optional uid As String = "", Optional pwd As String = "", _
Optional dbname As String = "") As Boolean
Dim connStr As String
If (server = "") Then server = "DBServer"
If (uid = "") Then uid = "User1"
If (pwd = "") Then pwd = "1234"
If (dbname = "") Then dbname = "Database1"
If (uid = "") Then
connStr = "DRIVER={SQL Server};SERVER=" & server & ";Trusted_Connection=Yes;APP=Office 2007 App;DATABASE=" & dbname
Else
'connStr = "DRIVER={SQL Server};SERVER=" & server & ";UID=" & uid & ";PWD=" & pwd & ";APP=Office 2007 App;DATABASE=" & dbname
connStr = "Provider=SqlOleDb;Data Source=DBServer;Initial Catalog = Database1;UID=" & uid & ";PWD=" & pwd & ";Options=-1;"
End If
If (LinkID Is Nothing) Then
Set LinkID = New ADODB.Connection
On Error Resume Next
LinkID.Open connStr
On Error GoTo 0
If (LinkID.State = 0) Then
ErrorNo = Err.Number
ErrorTxt = Err.Description
End If
End If
connect = LinkID.State
End Function
Public Function query(Optional queryStr As String = "") As Boolean
If (queryStr = "") Then Exit Function
If Not (connect) Then Exit Function
If (QueryID Is Nothing) Then
Set QueryID = New ADODB.Recordset
ElseIf (QueryID.State) Then
free_result
End If
On Error Resume Next
QueryID.Open queryStr, LinkID, adOpenForwardOnly, adLockOptimistic, -1 ', adLockBatchOptimistic
On Error GoTo 0
Row = 0
If (QueryID.State = 0) Then
ErrorNo = Err.Number
ErrorTxt = Err.Description
End If
NumRows = count_records
query = QueryID.State
End Function
Public Sub free_result()
If Not (QueryID Is Nothing) Then
QueryID.Close
End If
End Sub
Public Function count_records() As Integer
count_records = 0
If Not (QueryID Is Nothing) Then
If (QueryID.State) Then
While (Not QueryID.EOF)
count_records = count_records + 1
QueryID.MoveNext
Wend
If (count_records) Then
QueryID.Requery
End If
End If
End If
End Function
Sub Test()
query "SELECT * FROM Table1 WHERE Empl = 'Tom'"
query "INSERT INTO Table1 (EMPL)Values ('Tod')"
query "DELETE FROM Table1 WHERE Empl = 'Tod'"
End Sub
RecordSet.Open is only used to open a cursor (select) not execute some DML. For this you can use Connection.Execute. The last can also be used to create a RecordSet.
See for example [http://msdn.microsoft.com/en-us/library/ms807027.aspx]
Related
I have a program in vb.net where I need data inserted into the database. When I run this code I get an error:
Command text was not set for the command object
Here is the code I have:
Private Sub InsertRelease(strRelease As String, rowInserted As Boolean)
On Error GoTo errH
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strPath As String
Dim intImportRow As Integer
Dim objType As String
Dim strUsername, strPassword, strTable, strDatabase, strDsn, strSystem, strNewSql, sqlStr As String
Dim intRecsAffected As Integer
Dim boolRowInserted As Boolean
strDsn = ComboBox1.Text
strSystem = txtSystem.Text
strUsername = txtUser.Text
strPassword = txtPassword.Text
If con.State <> 1 And strUsername <> "" And strPassword <> "" Then
con.Open("{iSeries As ODBC Driver};System=" + strSystem + ";Dsn=" + strDsn + "; Uid=" + strUsername + "; Pwd=" + strPassword + ";")
Else
MessageBox.Show("Please enter the correct UserName And Password")
txtUser.Focus()
con = Nothing
End If
sqlStr = "insert into jobscopedb.ppusrfs (search_key_uf,DATA_ITEM_UF, NUMERIC_VALUE_UF) values (strRelease,'81 AB',0);"
strNewSql = ""
con.Execute(strNewSql, intRecsAffected)
con.Close()
con = Nothing
boolRowInserted = (intRecsAffected > 0)
If (boolRowInserted) Then
MessageBox.Show("Release " + strRelease + " added")
Else
MessageBox.Show("Release " + strRelease + "not added")
End If
Exit Sub
errH:
MsgBox(Err.Description)
con = Nothing
End Sub
The following demonstrates what your code might look like using ADO.net.
Pass the connection string directly to the constructor of the connection and pass the command text and connection to the constructor of the command. Open the connection and execute the command. ExecuteNonQuery returns rows affected.
Always use parameters to avoid sql injection.
Private Sub InsertRelease(strRelease As String)
Dim intRecsAffected As Integer
Dim strDsn = ComboBox1.Text
Dim strSystem = txtSystem.Text
Dim strUsername = txtUser.Text
Dim strPassword = txtPassword.Text
'Validate Input
If strUsername = "" OrElse strPassword = "" Then
MessageBox.Show("Please enter the correct UserName And Password")
txtUser.Focus()
Exit Sub
End If
Using con As New OdbcConnection($"{{iSeries As ODBC Driver}};System={strSystem};Dsn={strDsn}; Uid={strUsername}; Pwd={strPassword};"),
cmd As New OdbcCommand("insert into jobscopedb.ppusrfs (search_key_uf, DATA_ITEM_UF, NUMERIC_VALUE_UF) values (#Release,'81 AB',0);", con)
cmd.Parameters.Add("#Release", OdbcType.VarChar).Value = strRelease
con.Open()
intRecsAffected = cmd.ExecuteNonQuery
End Using 'Closes and disposes the connection and command even it there is an error
If intRecsAffected = 1 Then
MessageBox.Show("Release " + strRelease + " added")
Else
MessageBox.Show("Release " + strRelease + "not added")
End If
End Sub
I have a sub which creates a recordset. A function is called with values from the recordset. The goal is to use multiple values from the recordset, however, there is a possibility that a recordset value is null, then the function call will result in an error: "Invalid use of Null". To handle this error, each time the recordset value is checked for null values, if it is null, it will be replaced with an empty string. However, the way I have programmed this feels very inefficient, even more when later on more than ten parameters should be checked. Is there a way to do this more efficiently?
I have skipped the last part off the code as this is not necessary to understand my question. I've replaced it with ......... If needed, I will edit and provide full code.
Sub CallFunctionWithArray()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim arrValues(1 To 3) As Variant
Set conn = New ADODB.Connection
conn.Open "provider=Microsoft.JET.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\Northwind.mdb"
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM CustomersCopy", conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not (rst.EOF And rst.BOF) Then
rst.MoveFirst
Do Until rst.EOF = True
If IsNull(rst![CompanyName]) Then
arrValues(1) = ""
Else
arrValues(1) = rst![CompanyName]
End If
If IsNull(rst![DateTest]) Then
arrValues(2) = ""
Else
arrValues(2) = rst![DateTest]
End If
If IsNull(rst![INTTest]) Then
arrValues(3) = ""
Else
arrValues(3) = rst![INTTest]
End If
Call ReturnValuesOfArray(arrValues(1), arrValues(2), arrValues(3))
.........
End Sub
Function ReturnValuesOfArray(ByVal ValueOne As String, ByVal ValueTwo As String, ByVal ValueThree As String)
Debug.Print "Waarde variabele 1: " & ValueOne
Debug.Print "Waarde variabele 2: " & ValueTwo
Debug.Print "Waarde variabele 3: " & ValueThree
End Function
There is no problem with the code, it does what it's supposed to do. However, I will be passing many more parameters to the function when this is going to be really used.
You could loop through the fields of your Recordset instead of hard coding for every field. Using your code as a starting point, it could look something like this:
Private Sub Test()
Dim rst As ADODB.Recordset
Dim i As Integer
If Not (rst.EOF And rst.BOF) Then
rst.MoveFirst
Do Until rst.EOF = True
For i = 0 To rst.Fields.Count - 1
If IsNull(rst.Fields(i).Value) Then
arrValues(i) = ""
Else
arrValues(i) = rst.Fields(i).Value
End If
Next
Loop
End If
End Sub
Incorporating the ideas presented by #HansUp and #Mathieu Guindon, the code is even shorter:
Private Sub Test()
Dim rst As ADODB.Recordset
Dim i As Integer
Do Until rst.EOF
For i = 0 To rst.Fields.Count - 1
arrValues(i + 1) = Nz(rst.Fields(i).Value, "")
Next
Loop
End Sub
The rest of your code can be simplified, too, while allowing for any number of parameters:
Function ReturnValuesOfArray(ByVal Values As Variant)
Dim i As Integer
For i = LBound(Values) To UBound(Values)
Debug.Print "Waarde variabele " & i & ": " & Values(i)
Next
End Function
The Nz Function does what I think you want.
arrValues(1) = Nz(rst![CompanyName], "")
arrValues(2) = Nz(rst![DateTest], "")
arrValues(3) = Nz(rst![INTTest], "")
I am having a really strange issue with classic asp insert/update that worked flawlessly for years and was never altered. Out of the blue, the table is no longer updating or taking new records. The code does not throw any errors and the SQL Server log shows no errors either. Other tables in the same database work fine so I can insert and update without issues.
Is there a way to find out what is happening with this table or whether it is locked for some reason. I restarted SQL Server and web application, even the server and no luck.
I updated the table directly in SQL Server and it updates and inserts new records fine.
I used the same code on another table and was able to update records.
Can someone please point me in the right direction as I am out ideas on what may be causing this.
Thanks in advance.
Here is the code:
<%
' *** Edit Operations: (Modified for File Upload) declare variables
Dim MM_editAction
Dim MM_abortEdit
Dim MM_editQuery
Dim MM_editCmd
Dim MM_editConnection
Dim MM_editTable
Dim MM_editRedirectUrl
Dim MM_editColumn
Dim MM_recordId
Dim MM_fieldsStr
Dim MM_columnsStr
Dim MM_fields
Dim MM_columns
Dim MM_typeArray
Dim MM_formVal
Dim MM_delim
Dim MM_altVal
Dim MM_emptyVal
Dim MM_i
MM_editAction = CStr(Request.ServerVariables("SCRIPT_NAME"))
If (UploadQueryString <> "") Then
MM_editAction = MM_editAction & "?" & Server.HTMLEncode(UploadQueryString)
End If
' boolean to abort record edit
MM_abortEdit = false
' query string to execute
MM_editQuery = ""
%>
<%
' *** Insert Record: (Modified for File Upload) set variables
If (CStr(UploadFormRequest("MM_insert")) = "update") Then
MM_editConnection = MM_ar_inventory_STRING
MM_editTable = "Artists"
MM_editRedirectUrl = "artists_add.asp?status=ok"
MM_fieldsStr = "ArtistName|value|WebsiteStatus|value|Biography|value|Notes|value|ImageFileName|value|ModifiedBy|value|DT|value|IpAddress|value"
MM_columnsStr = "ARTST_Artist|',none,''|ARTST_WebsiteStatus|',none,''|ARTST_Biography|',none,''|ARTST_Notes|',none,''|ARTST_ArtistImageFileName|',none,''|ARTST_ModifiedBy|',none,''|ARTST_LastModified|',none,NULL|ARTST_LastModifiedIP|',none,''"
' create the MM_fields and MM_columns arrays
MM_fields = Split(MM_fieldsStr, "|")
MM_columns = Split(MM_columnsStr, "|")
' set the form values
For MM_i = LBound(MM_fields) To UBound(MM_fields) Step 2
MM_fields(MM_i+1) = CStr(UploadFormRequest(MM_fields(MM_i)))
Next
' append the query string to the redirect URL
If (MM_editRedirectUrl <> "" And UploadQueryString <> "") Then
If (InStr(1, MM_editRedirectUrl, "?", vbTextCompare) = 0 And UploadQueryString <> "") Then
MM_editRedirectUrl = MM_editRedirectUrl & "?" & UploadQueryString
Else
MM_editRedirectUrl = MM_editRedirectUrl & "&" & UploadQueryString
End If
End If
End If
%>
<%
' *** Insert Record: (Modified for File Upload) construct a sql insert statement and execute it
Dim MM_tableValues
Dim MM_dbValues
If (CStr(UploadFormRequest("MM_insert")) <> "") Then
' create the sql insert statement
MM_tableValues = ""
MM_dbValues = ""
For MM_i = LBound(MM_fields) To UBound(MM_fields) Step 2
MM_formVal = MM_fields(MM_i+1)
MM_typeArray = Split(MM_columns(MM_i+1),",")
MM_delim = MM_typeArray(0)
If (MM_delim = "none") Then MM_delim = ""
MM_altVal = MM_typeArray(1)
If (MM_altVal = "none") Then MM_altVal = ""
MM_emptyVal = MM_typeArray(2)
If (MM_emptyVal = "none") Then MM_emptyVal = ""
If (MM_formVal = "") Then
MM_formVal = MM_emptyVal
Else
If (MM_altVal <> "") Then
MM_formVal = MM_altVal
ElseIf (MM_delim = "'") Then ' escape quotes
MM_formVal = "'" & Replace(MM_formVal,"'","''") & "'"
Else
MM_formVal = MM_delim + MM_formVal + MM_delim
End If
End If
If (MM_i <> LBound(MM_fields)) Then
MM_tableValues = MM_tableValues & ","
MM_dbValues = MM_dbValues & ","
End If
MM_tableValues = MM_tableValues & MM_columns(MM_i)
MM_dbValues = MM_dbValues & MM_formVal
Next
MM_editQuery = "insert into " & MM_editTable & " (" & MM_tableValues & ") values (" & MM_dbValues & ")"
If (Not MM_abortEdit) Then
' execute the insert
Set MM_editCmd = Server.CreateObject("ADODB.Command")
MM_editCmd.ActiveConnection = MM_editConnection
MM_editCmd.CommandText = MM_editQuery
MM_editCmd.Execute
MM_editCmd.ActiveConnection.Close
If (MM_editRedirectUrl <> "") Then
Response.Redirect(MM_editRedirectUrl)
End If
End If
End If
%>
I notice that UploadQueryString is undefined so if you add this as the fist line
<%OPTION EXPLICIT%>
I guess that you will get some meaningful error messages
The craziest solution to the problem that totally seems unrelated was to disable Symantec Endpoint Protection (Network Protection) and it worked for a reason I cannot possibly explain! Thank you all for the suggestions above.
Dim ColNames(7) As String
Dim Values(7) As Object
Dim now As DateTime = DateTime.Now()
ColNames(0) = "Int1"
ColNames(1) = "Int2"
ColNames(2) = "String1"
ColNames(3) = "String2"
ColNames(4) = "String3"
ColNames(5) = "String4"
ColNames(6) = "String5"
ColNames(7) = "String6"
Values(0) = intVar1
Values(1) = intVar2
Values(2) = strVar1
Values(3) = strVar2
Values(4) = strVar3
Values(5) = strVar4
Values(6) = strVar5
Values(7) = strVar6
Dim goodToInsert As Boolean = True
For i As Integer = 0 To 7
If Values(i) = Nothing OrElse Len(Values(i)) = 0 Then
goodToInsert = False
End If
Next
If goodToInsert Then
accessDatabase.InsertIntoTable("MyTable", ColNames, Values)
End If
This part of the code handles gathering data to insert into my access database.
Public Sub InsertIntoTable(ByRef TableName As String, ByRef ColumnName() As String, ByRef KeyValue() As Object)
'ColumnName and KeyValue need to have the same number of elements
'be careful when attemping to insert a value into the PrimaryKey Column as it may be of a type that cannot but manually changed
'INSERT NEW DATA INTO A TABLE
' INSERT INTO {tablename} ([{columnname1}], [{columnname2}], [{columnname3}], ...) VALUES ('{string}', {number}, {boolean}, ...), oledbconnection
Dim ColumnString As String = vbNullString
Dim KeyString As String = vbNullString
For i As Integer = 0 To ColumnName.GetUpperBound(0)
'build the column names part of the string
If i <> ColumnName.GetUpperBound(0) Then
ColumnString = ColumnString & "[" & ColumnName(i) & "], "
Else
ColumnString = ColumnString & "[" & ColumnName(i) & "]"
End If
'build the values part of the string
Dim TempValue As String = vbNullString
If KeyValue(i) <> Nothing Then
If KeyValue(i).GetType.ToString = "System.String" Then
TempValue = "'" & KeyValue(i) & "'"
Else
TempValue = KeyValue(i)
End If
If i <> KeyValue.GetUpperBound(0) Then
KeyString = KeyString & vbNullString & TempValue & ", "
Else
KeyString &= TempValue
End If
Else
Debug.Print("Nothing")
If i <> KeyValue.GetUpperBound(0) Then
KeyString &= ", "
End If
End If
Next
Dim con As New OleDbConnection
Dim da As New OleDbDataAdapter
Dim sql As New OleDbCommand
con.ConnectionString = Connection()
con.Open()
Dim commandText As String = "INSERT INTO " & TableName & " (" & ColumnString & ") VALUES (" & KeyString & ")"
Try
sql.Connection = con
sql.CommandText = commandText
da.InsertCommand = sql
da.InsertCommand.ExecuteNonQuery()
Catch ex As Exception
Debug.Print(ex.ToString)
End Try
con.Close()
End Sub
This is the InsertIntoTable function.
The function runs properly and inserts data into my table correctly, but in my debug output I keep noticing this error on every call to da.InsertCommand.ExecuteNonQuery():
First-chance exception at 0x761EC42D in 3024 Card Sorter.exe: Microsoft C++ exception: int at memory location 0x003ED1EC.
First-chance exception at 0x761EC42D in 3024 Card Sorter.exe: Microsoft C++ exception: int at memory location 0x003ED1EC.
I was able to use the Visual Studio debugger to narrow it down to ExecuteNonQuery() being where it occurs, but I'm having trouble understanding what it means, and how to go about resolving it. I've attempted changing my intVars to Strings with no luck to resolving the exception, and I'm also extremely curious why this isn't being caught by my Try...Catch.
Can someone please help me with that?
My prob is that When i use dataAdapter.Update in this next construction i get a return value of zero (no line was updated but no reason or errors return).
The update sentense works when i run it using Access and other update requests works fine when i work on a single table.
Im Using:
vb.net \ visual studio 2012 \ access 2010 DB
I update the Data on my DataGridView and call the update function:
update command:
Private Function createGeneralUpdateStatement() As String
Return "UPDATE EntitysDataTbl INNER JOIN ManagersExtraDataTbl ON EntitysDataTbl.entityID = ManagersExtraDataTbl.managerID " + _
"SET EntitysDataTbl.entityUserName = [#EntitysDataTbl].entityUserName, " + _
"EntitysDataTbl.entityLastEntry = [#EntitysDataTbl].entityLastEntry, " + _
"ManagersExtraDataTbl.mPassword = [#ManagersExtraDataTbl].mPassword, " + _
"ManagersExtraDataTbl.workGroup = [#ManagersExtraDataTbl].workGroup, " + _
"ManagersExtraDataTbl.entityAccessType = [#ManagersExtraDataTbl].entityAccessType, " + _
"ManagersExtraDataTbl.mActive = [#ManagersExtraDataTbl].mActive" + _
"WHERE EntitysDataTbl.entityID= [#EntitysDataTbl].entityID"
End Function
The parameters are:
Dim parmList(2) As String
parmList(0) = "mPassword"
parmList(1) = "entityUserName"
and the update function is:
Public Function updateDB(ByVal updateCommand As String, ByVal parmList() As String, Optional ByVal insertCommand As String = "") As Boolean
Dim res As Boolean = False
SyncLock Me
Try
mainDataSet.EndInit()
mUpdateCommand = New OleDb.OleDbCommand(updateCommand, MyBase.getConnector)
For Each Str As String In parmList
If Not Str Is Nothing Then
If (Str.StartsWith("%")) Then
mUpdateCommand.Parameters.Add("#" & Str.Trim("%"), OleDb.OleDbType.Boolean, MAX_COL_LEN, Str.Trim("%"))
Else
mUpdateCommand.Parameters.Add("[#" & Str & "]", OleDb.OleDbType.VarChar, MAX_COL_LEN, Str)
End If
End If
Next
mDataAdapter.UpdateCommand = mUpdateCommand
If (Not insertCommand.Equals("")) Then
mInsertCommand = New OleDb.OleDbCommand(insertCommand, MyBase.getConnector)
For Each Str As String In parmList
If Not Str Is Nothing Then
'If Str.Equals("RuleIDNum") Then
' Continue For
'End If
If (Str.StartsWith("%")) Then
mInsertCommand.Parameters.Add("#" & Str.Trim("%"), OleDb.OleDbType.Boolean, MAX_COL_LEN, Str.Trim("%"))
Else
mInsertCommand.Parameters.Add("[#" & Str & "]", OleDb.OleDbType.VarChar, MAX_COL_LEN, Str)
End If
End If
Next
mDataAdapter.InsertCommand = mInsertCommand
End If
Dim i As Integer = mDataAdapter.Update(mainDataSet)
'ERROR - i = 0 => NO LINE WAS UPDATED!!!!
res = True
Catch ex As Exception
res = False
End Try
mDBWasUpdated = res
End SyncLock
Return res
End Function