I am trying to use VBA to insert rows into SQl Server. When I do a small test of about 5 records it works as expected and the new data is inserted. However when I run a full test (100,000 + records) the code runs but no records are inserted. If I copy the INSERT statements into SSMS and execute them all 100,000+ insert with no errors. Am I going over some sort of limit that VBA has? Below is the code I am currently working with.
Public Sub OpenConn()
Set cn = New ADODB.Connection
With cn
.ConnectionString = "Provider=SQLOLEDB;Data Source=USHDEVEVRSTDB\SDEVOLTP4;Initial
Catalog=DataManagement;Integrated Security=SSPI;": .Open
End With
End Sub
Public Sub DisposeConn()
cn.Close
Set cn = Nothing
End Sub
Public Sub WriteData()
With Application
.DisplayAlerts = True: .ScreenUpdating = False: .EnableEvents = False
End With
Dim strSQL As String
Dim wkbTarget As Workbook
Dim Comments As String
Dim Lastrow As Integer
Dim rng As Range
Dim row As Range
Set wkbTarget = ThisWorkbook
On Error GoTo Dispose
Call OpenConn
'SELECT THE RANGE ON THE SQLINSTERTSTRINGS SHEET TO SET AS THE COMMENTS AND INSERT THEM
Sheets("SQLInsertStrings").Activate
Lastrow = Range("A" & Rows.count).End(xlUp).row
Set rng = Range("A2:A" & Lastrow)
For Each row In rng.Rows
strSQL = row
Set cmd = New ADODB.Command
With cmd
Set .ActiveConnection = cn
.CommandText = strSQL
.CommandTimeout = 0
.Execute
End With
strSQL = ""
Next row
'CLOSE SUB
Dispose:
Call DisposeConn
With Application
.DisplayAlerts = True: .ScreenUpdating = True: .EnableEvents = True
MsgBox "Update Complete", vbInformation, "Confimation Message"
End With
End Sub
quite new to VBA. I tried to fix this problem by my own but any of the open threats seems to fit in what I need.
Context:
I have this Macro that brings info from a DDBB and copies it in a new Workbook. I would like to organize different queries in different modules than the main one and call them on demand.
Problem:
I have set my query in a new module as a string, but I get ByRef or Method or data member not found all the time:
Main Sub
Sub Consulta_Sql_ERP()
'Declare variables
Set objMyConn = New ADODB.Connection
Set objMyRecordset = New ADODB.Recordset
Dim strSQL As String
Dim ws2 As Workbook
Dim iCols As Integer
'Open Connection'
objMyConn.ConnectionString = "Provider=SQLOLEDB.1;
Data Source=(...);
Initial Catalog=(...);
User ID=(...);
Password=(...);
Persist Security Info=True;"
objMyConn.Open
'Set and Excecute SQL Command'
strSQL = Module4.Querys(Query1)
'Open Recordset'
Set objMyRecordset.ActiveConnection = objMyConn
objMyRecordset.Open strSQL
'Open a NewWorkbook
Call NewBook
'Copy Data to the new book
Set ws2 = ActiveWorkbook
ws2.Worksheets("Sheet1").Activate
'Copy headers
For iCols = 0 To objMyRecordset.Fields.Count - 1
Worksheets("Sheet1").Cells(1, iCols + 1).Value = objMyRecordset.Fields(iCols).Name
Next
ActiveSheet.Range("A2").CopyFromRecordset (objMyRecordset)
objMyConn.Close
'Close and save
Call carpetaventas
'ws.SaveAs Savechanges:=True, Filename:="" & Format(Date, "yyyymmdd")
'ws2.Close Savechanges:=True, Filename:="" & Format(Date, "yyyymmdd"),
'RouteWorkbook:="C:\Ventas"
End Sub
The module in which I have the String of my query is "Module4"
Sub in which I have my Query:
Sub Queries(Query1 As String)
Set Query1 = "Select * from table1"
End Sub
It works if I directly introduce the Query after "strSQL" but not if I "call" the Sub on Module4. Any ideas?
Thanks a lot in advance.
strSQL = Module4.Query1()
Function Query1() As String
Query1 = "Select * from table1"
End Sub
I have built a database that I get an occasional error in.
I have a bound form in split form/datasheet view. Occasionally when updating records, I get the "Update or CancelUpdate without AddNew or Edit" error when moving to a new record. This will happen in either the single record form, or on the datasheet.
It does not happen every time the record is saved. Maybe 1 out of 20 or 30 times.
I do have an AuditTrail built in, which is my only guess as to what may be causing the problem.
The VBA on the form:
Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("ApptID", "DELETED PRIOR RECORD")
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
Call AuditChanges("ApptID", "NEW")
Else
Call AuditChanges("ApptID", "EDIT")
End If
End Sub
Private Sub Form_Delete(Cancel As Integer)
If Status = acDeleteOK Then Call AuditChanges("ApptID", "DELETE BUTTON HIT")
End Sub
The AuditTrail code is:
Sub AuditChanges(IDField As String, UserAction As String)
On Error GoTo AuditChanges_Err
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM AuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
Select Case UserAction
Case "EDIT"
For Each ctl In Screen.ActiveControl.Parent.Controls
If ctl.Tag = "Audit" Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveControl.Parent.Name
![Action] = UserAction
![RecordID] = Screen.ActiveControl.Parent.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
End With
End If
End If
Next ctl
Case Else
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveControl.Parent.Name
![Action] = UserAction
![RecordID] = Screen.ActiveControl.Parent.Controls(IDField).Value
.Update
End With
End Select
AuditChanges_Exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditChanges_Exit
End Sub
If the error doesn't involve the VBA code, I have no idea what the problem could be.
I concur with dbmitch; adding some extra info to your error message would be a great help.
In addition, if that doesn't get you exactly what you want, you can also implement the little-known ERL function. Most people don't even know that Access can trap at the line level if they add line numbers (are you old enough to remember Basic?) to their code.
So, something like:
Sub AuditChanges(IDField As String, UserAction As String)
10 On Error GoTo AuditChanges_Err
20 Dim cnn As ADODB.Connection
30 Dim rst As ADODB.Recordset
40 Dim ctl As Control
50 Dim datTimeCheck As Date
60 Dim strUserID As String
70 Set cnn = CurrentProject.Connection
80 Set rst = New ADODB.Recordset
etc...
And then you could change your error handler to be something like:
400 MsgBox "UserAction: " & UserAction & vbCrLf & _
"IDField: " & IDField & vbCrLf & _
"Error Line: " & Erl & vbCrLf & _
"Error: (" & Err.Number & ") " & Err.Description, vbCritical, "ERROR!"
Turns out that the problem didn't seem to have any issues with the AuditTrail code.
There is a combobox that was getting hung up occasionally when moving to a new record.
I added the code below to the 'On Exit' event for the field, and I haven't seen the error come up since.
If Me.Dirty Then
Me. Dirty = False
End If
I have a record set created mannually as follows
Dim rs As ADODB.Recordset
rs.Open Dim Fields() As String
Fields(0) = ""
Fields(1) = "January"
Fields(2) = "February"
Fields(3) = "March"
Fields(4) = "April"
Fields(5) = "May"
rs.AddNew Fields
rs.Close
I've been trying to bind it to my combobox as follows
combo1.RowSource = rs
combo1.BoundColumn = "Fields"
Set rs = Nothing
I see compiliation error at: combo1.RowSource = rs
Please help me in binding this recordset to my combo box. Thanks in advance
I assume you are playing with a DataCombo based on the odd set of things mentioned in your question above.
You're a bit off with your attempt to create a fabricated Recordset. You also need a "destination" for selected or entered data so you need a DataSource and DataField.
While many fear and loathe VB6 data binding, there really isn't much to it. It helps to have taken one of the formal VB6 courses covering the topic but sadly those haven't been offered for quite a long time. The textbooks can still be had, though these days it seems to be a lot to expect anyone to do any actual study.
Here I have several Command buttons, a DataCombo, and a multiline TextBox:
Option Explicit
Private rsValues As ADODB.Recordset
Private rsData As ADODB.Recordset
Private Sub NewEnabled(ByVal Enable As Boolean)
DataCombo1.Enabled = Enable
cmdSave.Enabled = Enable
cmdCancel.Enabled = Enable
cmdNew.Enabled = Not Enable
cmdDump.Enabled = Not Enable
End Sub
Private Sub cmdCancel_Click()
rsData.CancelUpdate
NewEnabled False
End Sub
Private Sub cmdDump_Click()
With rsData
Text1.Text = vbNullString
Text1.SelText = "Records: " & CStr(.RecordCount) & vbNewLine
If .RecordCount > 0 Then
.MoveFirst
Do Until .EOF
Text1.SelText = CStr(.AbsolutePosition) _
& ": " & CStr(!Month.Value) & vbNewLine
.MoveNext
Loop
End If
End With
End Sub
Private Sub cmdNew_Click()
rsData.AddNew
rsData!Month.Value = vbNullString
NewEnabled True
End Sub
Private Sub cmdSave_Click()
rsData.Update
NewEnabled False
End Sub
Private Sub Form_Load()
Dim Month As Integer
Set rsValues = New ADODB.Recordset
With rsValues
.CursorLocation = adUseClient
.Fields.Append "MonthName", adVarWChar, 255
.Open
.AddNew Array(0), Array(vbNullString)
For Month = 1 To 12
.AddNew Array(0), Array(MonthName(Month))
Next
End With
Set rsData = New ADODB.Recordset
With rsData
.CursorLocation = adUseClient
.Fields.Append "Month", adVarWChar, 255
.Open
End With
With DataCombo1
.ListField = "MonthName"
Set .RowSource = rsValues
.DataField = "Month"
Set .DataSource = rsData
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
rsData.Close
rsValues.Close
End Sub
This works just fine. However it may not be what you were after at all. That is really hard to tell from some code in a vacuum, especially when it appears to be air code that isn't close to correct.
Before you go any further with this, take a look at this. It's pretty simple to bind the control by hand, and avoids all sorts of subtle headaches that you will encounter in VB6 data binding. I have used data binding only once in the many thousands of lines of vb6 code I have delivered to customers, and that was to work around a very esoteric bug in Microsoft's DataRepeater control.
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