I am trying to get some old VB6 code to work with SQL Server Compact.
I can connect, open the database and all seems well. I can run insert select commands which work.
However the ADODB.Recordset RecordCount property always returns -1 even though I can access the Fields and see the data. Changing the CursorLocation = adUseClient causes a problem when executung the SQL (multiple-step operation generated errors).
Option Explicit
Private Const mSqlProvider As String = "Provider=Microsoft.SQLSERVER.CE.OLEDB.3.5;"
Private Const mSqlHost As String = "Data Source=C:\Database.sdf;"
Private mCmd As ADODB.Command ' For executing SQL
Private mDbConnection As ADODB.Connection
Private Sub Command1_Click()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim DbConnectionString As String
DbConnectionString = mSqlProvider & _
mSqlHost
Set mDbConnection = New ADODB.Connection
mDbConnection.CursorLocation = adUseServer
Call mDbConnection.Open(DbConnectionString)
If mDbConnection.State = adStateOpen Then
Debug.Print (" Database is open")
' Initialise the command object
Set mCmd = New ADODB.Command
mCmd.ActiveConnection = mDbConnection
mCmd.CommandText = "select * from myTestTable"
mCmd.CommandType = adCmdText
Set rs = mCmd.Execute
Debug.Print rs.RecordCount ' Always returns -1 !!
Debug.Print rs.Fields(0) ' returns correct data for first row, first col
Debug.Print rs.Fields(1) ' returns correct data for first row, 2nd col
Debug.Print rs.Fields(2) ' returns correct data for first row, 3rd col
End If
End Sub
Any advice would be gratefully accepted.
Actually the CursorLocation plays a major role in this case. Use rs.CursorLocation = adUseClient to set the cursor location and try.
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
Dim DbConnectionString As String
DbConnectionString = mSqlProvider & _
mSqlHost
Set mDbConnection = New ADODB.Connection
mDbConnection.CursorLocation = adUseServer
Call mDbConnection.Open(DbConnectionString)
If mDbConnection.State = adStateOpen Then
Debug.Print (" Database is open")
' Initialise the command object
Set mCmd = New ADODB.Command
mCmd.ActiveConnection = mDbConnection
mCmd.CommandText = "select * from myTestTable"
mCmd.CommandType = adCmdText
Set rs = mCmd.Execute
Debug.Print rs.RecordCount ' This should now return the right value.
Debug.Print rs.Fields(0) ' returns correct data for first row, first col
Debug.Print rs.Fields(1) ' returns correct data for first row, 2nd col
Debug.Print rs.Fields(2) ' returns correct data for first row, 3rd col
End If
End Sub
That's a result of the type of cursor used to access the data, this post covers the issue and possible fixes.
http://www.devx.com/tips/Tip/14143
EDIT
I apologize for not being more attentive to the fact that you were dealing with Compact. With Compact the situation is similar to the one I referenced, as it uses forward only cursors by default (which do not support row count) but there are two other cursor types available as documented in the link below.
http://support.microsoft.com/kb/272067
From memory with working with VB6/ADO a long time ago the .RecordCount field doesn't return meaningful data until you've moved to the end of the recordset.
rs.MoveLast
rs.MoveFirst
Debug.Print rs.RecordCount
Though with this you'll need to make sure you have the appropriate cursor type (i.e., not forward only).
The only other solution I can think of is to do a separate SELECT COUNT(*) FROM myTestTable, etc but this has issues with the data changing between that call, and the one that actually returns the rows.
With Compact the default cursor attribute is adOpenForwardOnly for improved performance. As such RecordCount is returned as "-1" which means its not available, rather than blank. This is by design because the # of records in a dynamic cursor could change and result in pinging back and forth between the client server to maintain accuracy. However, if the record count is vital try setting it to use adOpenKeyset or adOpenStatic with a server-side cursor.
Check Recordset Property
The follow is result that RecordCount value returned by com.status.live code
+------------------+-------------------+-------------+---------------+--------------+
| CursorTypeEnum|adOpenForwardOnly=0|dOpenKeyset=1|adOpenDynamic=2|adOpenStatic=3|
|CursorLocationEnum| |
+------------------+-------------------+-------------+---------------+--------------+
|adUseServer = 2 | X | O | X | O |
|adUseClient = 3 | O | O | O | O |
+------------------+-------------------+-------------+---------------+--------------+
You may try something like this..
Set rs = mCmd.Execute
rs.MoveFirst
Do Until rs.EOF = true
Debug.Print rs.RecordCount ' Always returns -1 !!
Debug.Print rs.Fields(0) ' returns correct data for first row, first col
Debug.Print rs.Fields(1) ' returns correct data for first row, 2nd col
Debug.Print rs.Fields(2) ' returns correct data for first row, 3rd col
counter = counter + 1
rs.MoveNext
Loop
Here is a solution for you that I used
Dim recordnumber As Long
Dim SalRSrec As New ADODB.Recordset
Set SalRSrec = Nothing
SalRSrec.Open ("SELECT count(*) from SALARY where EMPID= '" & cmb_empid & "' ;"), Dbase, adOpenKeyset, adLockOptimistic
recordnumber = SalRSrec.GetString
MsgBox recordnumber
Replace Set rs = mCmd.Execute with:
set rs = new ADODB.Recordset
rs.Open "select * from myTestTable", mDBConnection, adOpenDynamic, adLockOptimistic
The adOpenDynamic will allow a forward/backward read through to get your recordcount.
Try using following code if still returns -1
Set Conn = createobject("ADODB.connection")
Set Rs = createobject("ADODB.recordset")
Conn.Open "DSN=DSN_QTP"
'Rs.Open "Select * From orders",Conn,adOpenDynamic,adLockBatchOptimistic
Rs.Open "Select * from [QTP-Table]",Conn,1 'Use either 1 or 3
'I tried using adopendynamic but it still returned -1. Using 1 it gave me correct count. 'Though I am using this code in QTP (Vbscript) same should work for VB6 also.
msgbox Rs.RecordCount
Below code might help you,
set conn = CreateObject("ADODB.Connection")
conn.open "<connection string>"
set rs = CreateObject("ADODB.Recordset")
sql = "SELECT columns FROM table WHERE [...]"
rs.open sql,conn,1,1
if not rs.eof then
nr = rs.recordcount
response.write "There were " & nr & " matches."
' ... process real results here ...
else
response.write "No matches."
end if
rs.close: set rs = nothing
conn.close: set conn = nothing
Set cn = CreateObject("ADODB.Connection")
strVerb = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\test.accdb"
tab1 = "tabelle1"
strSQL = "SELECT Count(*) FROM " & tab1
Debug.Print strSQL
cn.Open strVerb
Set rs = cn.Execute(strSQL)
Debug.Print rs.Fields(0)
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
you must set the CONNECTIOn to aduseClient, no recordset
and be carefoul to set only a new connection, if you use the same connection in your proyect, you can get other errors.
CRAETE A NEW CONNEXTION with aduseclient
Dim Sql As String
Dim CnCommand As New ADODB.Connection
On Error GoTo VerError:
Dim Comando As ADODB.Command
Set Comando = New ADODB.Command
CnCommand.ConnectionString = Cn.ConnectionString 'your exist connection in application
CnCommand.Open
CnCommand.CursorLocation = adUseClient
Set Comando.ActiveConnection = CnCommand
'Comando.ActiveConnection.CursorLocation = adUseClient
Comando.Parameters.Append Comando.CreateParameter("#Usuario", adInteger, adParamInput, , V_General.Usuario.Codigo)
Comando.CommandType = adCmdStoredProc
Comando.CommandText = "SP_Contratac"
Dim Rs As Recordset
Set Rs = New ADODB.Recordset
Set Rs = Comando.Execute()
This following code returns the recortcount exactly...
Public Sub test()
Dim cn As New ADODB.Connection()
Dim sPath As String = Application.ExecutablePath
sPath = System.IO.Path.GetDirectoryName(sPath)
If sPath.EndsWith("\bin") Then
sPath = sPath.Substring(0, Len(sPath) - 4)
End If
Dim DbConnectionString As String
DbConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" & sPath & "\students.mdb"
cn.ConnectionString = DbConnectionString
cn.Open()
Dim rs As New ADODB.Recordset()
rs.CursorLocation = ADODB.CursorLocationEnum.adUseClient
rs.CursorType = ADODB.CursorTypeEnum.adOpenStatic
rs.LockType = ADODB.LockTypeEnum.adLockBatchOptimistic
rs.Open("select * from students", cn)
MsgBox(rs.RecordCount)
rs.ActiveConnection = Nothing
cn.Close()
End Sub
Related
I'm pretty new at VBA and having an issue with ADO.
Currently the code im using returns fields (Name, Suburb, State) from a SQL database into a ListBox.
The code works fine as long as there are there all fields have a value, if there is a Null value it returns the error
Could not set the List property. Type mismatch
I need to find a way so if the Suburb and/or State fields return a Null value that it still populates the Listbox.
Any info would be greatly appreciated, thanks in advance!
Database entries
Screenshot of error
Dim cnn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQLquery As String
Dim cnnstr As String
Dim SQLName As String
Dim i As Integer
SQLName = "Salon"
SQLquery = "SELECT [Name], [Suburb], [State] FROM Salon WHERE Name like '" & SQLName & "%'"
Set cnn = New Connection
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=localhost; " & _
"Initial Catalog=MyDatabase;" & _
"User ID=sa;" & _
"Password=Password;" & _
"Trusted_Connection=Yes;"
cnn.Open cnnstr
cnn.Execute SQLquery
rs.Open SQLquery, cnn, adOpenStatic
rs.MoveFirst
i = 0
With Me.lb_search
.Clear
Do
.AddItem
.List(i, 0) = rs!Name
.List(i, 1) = rs!Suburb
.List(i, 2) = rs!State
i = i + 1
rs.MoveNext
Loop Until rs.EOF
End With
btn_search_test_Exit:
On Error Resume Next
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Iif can return an alternate for Null Values.
For example:
.List(i, 0) = IIf(IsNull(a), "(not found)", rs!Name)
will return "(not found)" if the value is null.
More info here and here.
nz is annoyingly not-available in Excel
Oh yes it is :-)
Public Function NZ(v As Variant, Optional valueifnull As Variant = 0) As Variant
If IsNull(v) Then
NZ = valueifnull
Else
NZ = v
End If
End Function
I'm currently working on a database in Access which has a table (Pro_Cons) who compares the pros and cons of different product-types. This table has 3 columns; Type (Product_type), Pros (Pro) and Cons.
For each of product-type I created a form which includes the pro- and the cons-field of the according type out of this table.
For adding new text to this fields I'm creating a VBA-function which is triggered by a button-click.
Because nothing worked as supposed to, I created the following function, which should only replace the Pro -field of the product type1 to change1.
Access doesnt throw an error, but nothing changes in the table.
Has someone an idea whats happening here?
Sub Change_Pos_Inf()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strSensortyp As String
Dim strNew As String
Set db = CurrentDb()
strProduct_type = "type1"
strNew = "change1"
strSQL = "SELECT Pro FROM Pro_Cons WHERE Product_type='strProduct_type';"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
With rst
If .RecordCount > 0 Then
.MoveFirst
.Edit
!Pro.Value = strNew
.Update
End If
End With
End Sub
I think your literal should be changed to reference a form control:
strSQL = "SELECT Pro FROM Pro_Cons WHERE Product_type='strProduct_type';"
Changes to:
strSQL = "SELECT Pro FROM Pro_Cons WHERE Product_type='" & Me!strProduct_type &
"'";
Please try the following code. It corrects your WHERE clause:
Sub Change_Pos_Inf()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strSensortyp As String
Dim strNew As String
Set db = CurrentDb()
strProduct_type = "type1"
strNew = "change1"
strSQL = "SELECT Pro FROM Pro_Cons WHERE Product_type= '" & strProduct_type & "';"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
With rst
If Not rst.EOF Then
.Edit
!Pro.Value = strNew
.Update
Else
MsgBox "No Record found!!"
End If
End With
rst.Close
Set rst = Nothing
End Sub
I have to write a program for my company's accountant, and I have a problem in returning articles' families in an array, all of the families I want to have have an Accounting code who begins with "707". Here's my code in VBScript :
Set objConnection = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\BASES\Base.mdb;Persist Security Info=False"
rs.CursorLocation = adUseClient
FamilleQuery = "Select Code from FamilleArticle Where CptVenteFrance Like '707%'"
rs.Open FamilleQuery, objConnection, adOpenStatic, adLockOptimistic
'rs.MoveFirst
'Do
'ListeFamille(rs.AbsolutePosition) = rs("Code")
'rs.MoveNext
'Loop until rs.EOF
'ListeFamilleString = rs.GetString(AdClipString, -1,"/","/"," ")
'ListeFamille = split(ListeFamilleString,"/")
'Set ListeFamille = rs.GetRows
'for i=0 to ubound(rs)
'ListeFamille(i) = rs.Fields("Code").Value(i)
'next
rs.Close
objConnection.Close
As comments you have all of my attempts to return the resultat of the recordset in an array and no one didn't work.
Can someone say where I'm wrong please ?
Give this a try
Option Explicit
'ADO Constants
Const adCmdText = 1
Const adParamInput = 1
Const adVarWChar = 202
'Would usually be passed in from somewhere
Dim value: value = "707%"
Dim cmd, rs, data
Dim conn: conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\BASES\Base.mdb;Persist Security Info=False"
Dim sql: sql = "Select Code from FamilleArticle Where CptVenteFrance Like ?"
Set cmd = Server.CreateObject("ADODB.Command")
With cmd
.ActiveConnection = conn
.CommandType = adCmdText
.CommandText = sql
Call .Parameters.Append(.CreateParameter("#value", adVarWChar, adParamInput, 50))
Set rs = .Execute(, Array(value))
If Not rs.EOF Then data = rs.GetRows()
Call rs.Close()
Set rs = Nothing
End With
Set cmd = Nothing
Dim row, rows
If IsArray(data) Then
'Test data (2d Array, 0 = column, 1 = row)
Call WScript.Echo(data(0, 0))
'Retrieving all rows
rows = UBound(data, 2)
For row = 0 To rows
'First column from each row.
Call WScript.Echo(data(0, row))
Next
Else
'No records returned
End If
Useful Links
Using Stored Procedure in Classical ASP .. execute and get results (talk about returning data as an Array you can traverse)
You don't need the Set in vbScript to set the array to the recordSet's rows. You only use a Set where setting an object reference, which isn't the case here.
ListeFamille = rs.GetRows will set ListeFamille to a 2 dimensional array with the results of the recordset in it.
Here's an excerpt from one of my own function libraries:
oConnection.open sConnectionString
oRecordSet.open sSql, oConnection
If oRecordSet.RecordCount = 0 Then
DataArray = ""
Else
oRecordSet.MoveFirst
DataArray = oRecordSet.GetRows
End If
I am trying to write an Exce-Vba code for SQL connection. The code, first will open the connection to the server, then it will copy a 4 columns of table (Range("C22:G81")) from my Excel-sheet to the SQL-server (I am only trying to send numerical table now as a test, I don't send any column name)
I have been trying to solve a "Application Defined or Object Defined" error quite long time. I get the error for the connection string strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strName & ";Extended Properties=""Excel 12.0;"
I even tried with another version with password option like strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strName & ";Extended Properties=""Excel 12.0; Jet OLEDB:Database Password='passwd';"
But I get the same error. I am quite new in SQL-coding. I wonder if I am missing something important.
Lasly, I don't know if it is related to this error, but I manually created 4 columns in the SQL server for my 4 columns in the Excel. Do I need to write something specific that those 4 columns in the Excel-sheet will find the right columns in the SQL-server?
Thanks in advance...
The code:
Private Sub inlasning()
Dim MyWorkBook As Workbook
Dim rs As New ADODB.Recordset
Dim conn As New ADODB.Connection
Dim ServerName As String, DataBaseName As String, strSQL As String
Set conn = New ADODB.Connection
ServerName = "E45c7642"
DataBaseName = "Tables"
' Specify the OLE DB provider
conn.Provider = "sqloledb"
' Set SQLOLEDB connection properties
conn.Properties("Data Source").Value = ServerName
conn.Properties("Initial Catalog").Value = DataBaseName
' Windows NT authentication.
conn.Properties("Integrated Security").Value = "SSPI"
conn.Open
Dim ValidSheet As Worksheet
Dim HeaderRange As Range
Dim DataRange As Range
Dim ColRange As Range
Dim LastRange As Range
Dim strName As String, strCon As String
strName = ThisWorkbook.FullName
Application.ScreenUpdating = False
Set ValidSheet = ThisWorkbook.Sheets("Sheet2") '
Set HeaderRange = ValidSheet.Range("C20:G21")
Set ColRange = HeaderRange.Find(TheHeader, , , xlWhole)
Set LastRange = ColRange.End(xlDown)
Set DataRange = ValidSheet.Range("C22:G81") ' This is what I am trying to transfer, only numeric values without column names
strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strName _
& ";Extended Properties=""Excel 12.0;"
conn.Open strCon
strSQL = "SELECT * FROM [" & ValidSheet.Name & "$" & Replace(DataRange, "$", "") & "];"
rs.Open strSQL, dbclass, adOpenStatic, adLockReadOnly
arrData = rs.GetRows
rs.Close
conn.Close
Set rs = Nothing
Set conn= Nothing
Set ValidSheet = Nothing
End Sub
After getting the same error for the "connection string", I changed the strategy, and I used dbclass procedure to open a connection. So the new code is like below. (I found this coding from a guy, but he is on vacation now, so I can't ask him).
It gets connection (dbclass) properties automatically, which are saved in the main ThisWorkbook. This code doesn't give any error at all, but it doesn't copy the column from the Excel to the database. I tried different versions for the sql-query, like SQL = .... VALUES('result') or SQL = .... VALUES(result), but there is no result again, without error.
Private Sub Testing_Click()
Dim FindColValues() As Double
Dim ValidBook As Workbook
Dim ValidSheet As Worksheet
Dim DataRange As Range
Dim dataa As Range
Application.ScreenUpdating = False
TheSheet = "Sheet2"
Set ValidSheet = Worksheets(TheSheet)
Set DataRange = ValidSheet.Range("C21:C81")
' Below creating an array "result(it)" from the seleced range.
For Each dataa In DataRange
ReDim Preserve result(it)
result(it) = dataa.Value
it = it + 1
Next
' Below is just an alternative array for "in case"
arrData = ValidSheet.Range("C22:G81").Value
SQL = "INSERT INTO Table_test (Column1) VALUES ('result()');"
dbclass.ExecuteSQL SQL
End Sub
Below is dbclass connection properties which is read automatically by the other function:
Private Sub Workbook_Open()
Dim connOk As Boolean
Dim rs As New ADODB.Recordset
Dim MyWorkBook As Workbook
Dim CurSheet As Worksheet
Set dbclass = New clsDB
dbclass.Database = "Tables"
dbclass.ConnectionType = SqlServer
dbclass.DataSource = "E45c7642"
dbclass.UserId = Application.UserName
connOk = dbclass.OpenConnection(False, True)
If connOk = False Then
MsgBox "Cannot connect"
Else
MsgBox "The server is connected"
End If
End Sub
Finally I found the problem for my second code. As I wrote before, in my alternative code (second code), I didn't get any error at all in VBA, but it didn't save my table into the server.
Now I know the reason, because my real value was in "comma" format, but the server saved the value in "dot" format. So I added Str(value) to convert the "comma" value to the "dot" value, and it works now:
....
SQL = "INSERT INTO Table_test (Column1) VALUES (" & Str(result(1)) & ")"
dbclass.ExecuteSQL SQL
End Sub
New to vb and am struggling with returning data from my recordset if variable equals a value in my array.
I think what I've done so far is correct but having trouble with the final bit. I need to script something to say "if value from range equals a value in my array then print the recordset".
I hope someone can help. I'm also new to vb so any suggestions on how to improve my code would be great. Thanks in advance!! Brian
Sub FindCardOrdersv2()
' Initialize variables.
Dim cn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim provStr As String
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim rsFilter As Range
Dim i As Integer
Dim rng As Variant
Dim payid(1 To 10) As String
Dim tw As ThisWorkbook
Workbooks("cleanse.xlsm").Activate
Worksheets("Sheet1").Activate
' Create new instances
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
' sql query
sql = "SELECT TOP 100 t.tri_transactionidcode," _
& "SUBSTRING(t.tri_reference, 1, 9) AS merchantref," _
& "t.tri_additionalreferencenumber, t.CreatedOn, t.tri_amount, ISNULL(t.tri_paymenttransactiontypeidName, 'Online')" _
& " FROM dbo.tri_onlinepayment t INNER JOIN dbo.tri_transaction tr ON tr.tri_onlinepaymentid = t.tri_onlinepaymentId" _
& " WHERE t.tri_transactionresult = 9"
' Specify the OLE DB provider.
cn.Provider = "sqloledb"
' Specify connection string on Open method.
cn.Open "Data Source=IFL-SQL11;Database=IFL_MSCRM;Trusted_Connection=yes;Integrated Security=SSPI"
' Assign active connection to recordset
Set rs.ActiveConnection = cn
'intMaxCol = rs.Fields.Count
' Define cursors and open sql
With rs
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open sql
End With
For i = 1 To 3
payid(i) = rs.Fields.Item(0)
Debug.Print rs(0)
Debug.Print rs(1)
Debug.Print rs(3)
rs.MoveNext
Next i
'rsFilter = Range("A1:A10")
For Each rsFilter In Range("A1:A10").Cells
If rsFilter.Value = payid Then
Debug.Print rs(1)
rs.MoveNext
End If
Next
'If rs.RecordCount > 0 Then
' With Worksheets("Sheet1")
' .Range("B1:B2").CopyFromRecordset rs
' End With
'End If
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
Add an extra for loop inside to compare every value in the range to the array values
For Each rsFilter In Range("A1:A10").Cells
For i=1 To 3
If rsFilter.Value = payid(i) Then
Debug.Print rs(1)
rs.MoveNext
End If
Next i
Next