I am trying to retrieve records saved in MS Access database and populate the textboxes with the query result during FORM_LOAD(). So far I retrieve one record. But the problem is, when I try adding the same codes, it is retrieving the first saved record.
It is disregarding the where clause in my sql statement. Here's what I wanted my output to be. During form_load(), I want to display multiple records (activity description/activity_desc) in multiple textboxes on my form. If there is no record in my database, I just want it to be blank.
Here's what i want to achive..
Here's my code snippet:
Private Sub Form_Load()
FrmSchedule.lblnamesched.Caption = FrmInfosheet.Txtname.Text
FrmSchedule.Label36.Caption = FrmInfosheet.cmbsalesgroup.Text
FrmSchedule.lblpositionsched = FrmInfosheet.Txtposition.Text
FrmSchedule.Thisweekdate.Caption = FrmInfosheet.Text3.Text
FrmSchedule.Thisweekdate2.Caption = FrmInfosheet.Text4.Text
FrmSchedule.Label37.Caption = FrmWeek1WAR.Label1.Caption
FrmSchedule.Label38.Caption = FrmWeek1WAR.Label2.Caption
FrmSchedule.Label39.Caption = FrmWeek1WAR.Label21.Caption
FrmSchedule.Label40.Caption = FrmWeek1WAR.Label22.Caption
FrmSchedule.Label41.Caption = FrmWeek1WAR.Label23.Caption
FrmSchedule.Label42.Caption = FrmWeek1WAR.Label37.Caption
FrmSchedule.Label43.Caption = FrmWeek1WAR.Label26.Caption
FrmSchedule.Label44.Caption = FrmWeek1WAR.Label27.Caption
FrmSchedule.Label45.Caption = FrmWeek1WAR.Label28.Caption
FrmSchedule.Label46.Caption = FrmWeek1WAR.Label29.Caption
FrmSchedule.Label47.Caption = FrmWeek1WAR.Label30.Caption
FrmSchedule.Label48.Caption = FrmWeek1WAR.Label38.Caption
Dim conConnection As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sqlStr As String
Dim clone_rs As ADODB.Recordset
Set conConnection = New ADODB.Connection
Set rs = New ADODB.Recordset
With conConnection
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\" & "WAP.mdb;Mode=Read|Write"
.Open
End With
With rs
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockBatchOptimistic
.ActiveConnection = conConnection
.Open "war", conConnection, adOpenForwardOnly
End With
'Set clone_rs = rs.Clone
With arsProjects
If rs.BOF And rs.EOF Then
.Requery
.MoveFirst
.MoveLast
Else
sqlStr = "SELECT activity_desc FROM war WHERE time = '8' and activity_date = '" & Label37.Caption & "' and sales_group = 'ALC Holdings CO., INC' and day = 'Monday'"
Text1.Text = rs.Fields("activity_desc")
sqlStr = "SELECT activity_desc FROM war WHERE time = '9' and activity_date = '" & Label38.Caption & "' and sales_group = 'ALC Holdings CO., INC' and day = 'Tuesday'"
Text2.Text = rs.Fields("activity_desc")
End If
End With
Set rs = Nothing
Set conConnection = Nothing
End Sub
If I'm doing it wrong, what would be the proper function or code for me to achieve what I wanted. Any help and suggestions would be much appreciated. By The way, I am trying to use multiple select query to achieve this.
Your assigning the SELECT statement to sqlStr but it doesn't look like your using sqlStr anywhere. In rs.Open you have a select statement of "war" and not sqlStr.
Related
I am working on a solution for a SQL database with Access form for data entry. In this application, I have customers, and am working to provide a sub-form that will show any possible duplicates.
In another post, I have found a solution for a stored procedure, which will identify 3 types of duplicates (exact, ones with a "difference" factor between 3 columns, and ones with the same name, where one address is null and one is not). This stored procedure also looks for one of the dupes, in each of the 3 types, to be the ID of the current customer I am evaluating.
That solution is here: Stack Overflow Post 64932557
Now, on the Access side, I made a private function on the main Customer's form, where I run the stored procedure, pass the ID parameter, and then seek to only show the subform and subform tab/page if there are results. All of that seems to work, but then when I loop through the recordset output from the stored procedure, I need to map that to the unbound fields of the subform. It does this for 1 of the duplicates, but not for all the results.
I am testing with a record that has 3 duplicates (including it's own record being returned). I only get 1 record on the continuous subform, and I should get 2 if not 3, if it will include it's own record.
I run this function as part of my navigation on the form, as the user goes to the next record, previous, uses a combo to jump to a record, or brings up a form to search for a record and then goes to that record.
Private Function FindDuplicates()
Dim cmd As New ADODB.Command
Dim conn As ADODB.Connection
Dim prm As ADODB.Parameter
Dim strConn As String
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim dRecs As Integer
strConn = "Provider=sqloledb;Server=MySQLServerName;Database=MyDBName;Trusted_Connection=yes;"
Set conn = New ADODB.Connection
conn.Open strConn
Set cmd = New ADODB.Command
cmd.CommandText = "sp_FindMyDuplicates"
cmd.CommandType = adCmdStoredProc
cmd.ActiveConnection = conn
Set prm = cmd.CreateParameter("CID", adInteger, adParamInput)
cmd.Parameters.Append prm
cmd.Parameters("CID").Value = Me.ID
'Execute the stored procedure
Set rs = cmd.Execute
dRecs = -1
With rs
' Debug.Print .RecordCount & " is record count"
If (rs.EOF = True) And (rs.BOF = True) Then
Me.pgDuplicates.Visible = False
Else
Me.pgDuplicates.Visible = True
If Not .BOF And Not .EOF Then
While (Not .EOF)
dRecs = dRecs + 1
'Debug.Print "customer ID: " & rs.Fields("ID") & " customer name: " & rs.Fields("FirstName")
Me.frmCustomers_subDuplicates.Form.txtFirst = rs.Fields("FirstName")
Me.frmCustomers_subDuplicates.Form.txtLast = rs.Fields("LastName")
Me.frmCustomers_subDuplicates.Form.txtAddress1 = rs.Fields("Add1")
Me.frmCustomers_subDuplicates.Form.txtAddress2 = rs.Fields("Add2")
Me.frmCustomers_subDuplicates.Form.txtCity = rs.Fields("City")
Me.frmCustomers_subDuplicates.Form.txtState = rs.Fields("State")
Me.frmCustomers_subDuplicates.Form.txtZip = rs.Fields("Zip")
.MoveNext
Wend
Me.frmCustomers_subDuplicates.Form.txtDuplicateCount = dRecs & " Duplicates Found"
End If
End If
.Close
End With
'Close the connection
conn.Close
End Function
Anyone see why I am not getting all the records in the recordset?
You are initializing dRecs with -1 instead of 0. So it will display one less.
It also seems that you are assigning the values to the same textboxes all the time, without adding new lines in the subform.
Insert the line
Me.frmCustomers_subDuplicates.SetFocus
before the loop and insert the line
DoCmd.GoToRecord , , acNewRec
after the line dRecs = dRecs + 1 to always insert a new record in the subform.
I ended up getting it worked out. Thank you all for your helpful comments and suggestions.
Private Function FindDuplicates()
Dim cmd As New ADODB.Command
Dim conn As ADODB.Connection
Dim prm As ADODB.Parameter
Dim strConn As String
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim dRecs As Integer
If Not Me.NewRecord Then
strConn = "Provider=sqloledb;Server=ServerName;Database=DatabaseName;Trusted_Connection=yes;"
Set conn = New ADODB.Connection
conn.Open strConn
Set cmd = New ADODB.Command
cmd.CommandText = "sp_FindMyDuplicates"
cmd.CommandType = adCmdStoredProc
cmd.ActiveConnection = conn
Set prm = cmd.CreateParameter("CID", adInteger, adParamInput)
cmd.Parameters.Append prm
cmd.Parameters("CID").Value = Me.ID
'Execute the Stored Procedure
cmd.Execute
If DCount("ID", "tblCustomerDupesTemp", "ID = " & Me.ID) = 0 Then
Me.pgDuplicates.Visible = False
Else
Me.pgDuplicates.Visible = True
Me.frmCustomer_subDuplicates.Form.Filter = "[ID] <> " & Me.ID & " And [AnchorID] = " & Me.ID
Me.frmCustomer_subDuplicates.Form.FilterOn = True
Me.frmCustomer_subDuplicates.Form.txtDuplicateCount = CStr(Me.frmCustomer_subDuplicates.Form.CurrentRecord) & " of " & _
DCount("ID", "tblCustomerDupesTemp", "ID <> " & Me.ID) & " Duplicate Customer(s)"
Me.frmCustomer_subDuplicates.Form.Requery
End If
End If
End Function
I have an Access DataBase and a form in Excel VBA. All the data I input into the DB is input through the VBA form.
This DB contains all the benefits cards we already received this year in the company. But the same employee can ask for the card twice or more, so we'll have more than one record on the DB for him.
What I need is when the number of records is greater than one, the SQL statement result should appear in a Excel report.
I use the SELECT (*) COUNT statement to know when there is more than one record that is compatible with the search criterion. But I can't make the result appear in an Excel file.
Here is my code:
Public Function Relatorio()
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rel As String
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"
cn.Open
Set rs = New ADODB.Recordset
sql = "INSERT INTO OPENROWSET('Microsoft.ACE.OLEDB.12.0', 'Excel 12.0;Database=" & enderecoDB & ";', 'SELECT * FROM [Planilha1$]') SELECT * FROM controle WHERE BP = " & controlectform.nmbpbox.Value & ";"
rs.Open sql, cn
End Function
When I run this code it gives me a message saying something like:
Can't locate the OPENROWSET Table exit
I'm not able to install new programs, so I need to do this using only Excel VBA and the Access DB.
How can I make this work?
I don't believe Access supports the OPENROWSET, dynamic table you're working with there. I have a lot of old projects that do this though, so here's my method
Public Function Relatorio()
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rel As String
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"
cn.Open
Set rs = New ADODB.Recordset
dim path_To_XLSX
dim name_of_sheet
path_To_XLSX = "c:\temp\output.xlsx"
name_of_sheet = "Planilha1"
sql = sql = "SELECT * INTO [Excel 12.0;Database=" & path_To_XLSX & "]." & name_of_sheet & " FROM controle WHERE BP = '" & controlectform.nmbpbox.Value & "';"
rs.Open sql, cn
'If this application is in an unsecure environment, use the following code instead! This is to prevent a SQL injection, security concern here.
'As it is an Access Database, this is likely overkill for this project
'Create Command Object.
Set Cmd1 = New ADODB.Command
Cmd1.ActiveConnection = cn
cmd1.CommandText = "SELECT * FROM controle INTO [Excel 12.0;Database=" & path_To_XLSX & "]." & name_of_sheet & " WHERE BP = ?"
' Create Parameter Object.
Set Param1 = Cmd1.CreateParameter(, adInteger, adParamInput, 5) 'use adVarchar for strings(versus adInteger), https://www.w3schools.com/asp/met_comm_createparameter.asp
Param1.Value = controlectform.nmbpbox.Value
Cmd1.Parameters.Append Param1
Set Param1 = Nothing
Set Rs = Cmd1.Execute()
End Function
I had this challenge so many years ago that I cant remember but this link ring the bell. check if it help.
https://stackoverflow.com/a/28889774/382588
try { connw.Open(); OleDbCommand command; command = new OleDbCommand( "Update Deliveries " + "SET Deliveries.EmployeeID = ?, Deliveries.FIN = ?, Deliveries.TodaysOrders = ? , connw); command.Parameters.Add(new OleDbParameter("#EMPID", Convert.ToDecimal(empsplitIt[1]))); command.Parameters.Add(new OleDbParameter("#FIN", truckSplit[1].ToString())); command.Parameters.Add(new OleDbParameter("#TodaysOrder", "R")); catchReturnedRows = command.ExecuteNonQuery();//Commit connw.Close(); } catch (OleDbException exception) { MessageBox.Show(exception.Message, "OleDb Exception"); }
you can use this, to print the actual SQL.
Private Sub Command2_Click()
Dim db As Database
Dim qr As QueryDef
Set db = CurrentDb
For Each qr In db.QueryDefs
TextOut (qr.Name)
TextOut (qr.SQL)
TextOut (String(100, "-"))
Next
End Sub
Public Sub TextOut(OutputString As String)
Dim fh As Long
fh = FreeFile
Open "C:\Users\rs17746\Desktop\Text_Files\sample.txt" For Append As fh
Print #fh, OutputString
Close fh
End Sub
Here is one more version for you. This will export the results of each query, each to a separate text file.
Private Sub Command0_Click()
Dim qdf As QueryDef
Dim strFileName As String
For Each qdf In CurrentDb.QueryDefs
If Left(qdf.Name, 1) <> "~" Then
'you need to figure out TransferText command. Maybe
'you won't be lazy and expect people to read it to
'you and tutor you on how it works.
strFileName = qdf.Name
'Docmd.TransferText ....
DoCmd.TransferText transferType:=acExportDelim, TableName:=strFileName, FileName:="C:\test\" & strFileName & ".txt", hasfieldnames:=True
End If
Next qdf
MsgBox "Done"
End Sub
I'm having problems with a String var in which I put a SQL query I've saved in MS Access. It works like this:
I generate a list through a SELECT query
Using a menu at a Userform with Excel VBA, I choose columns to order the list
As I will have to order many lists in many ways, I decided to create a Sub ordenar(ByVal sqlLista As String, ByVal sqlOrd As String).
sqlLista contains the name of the SELECT query that generates the list I want to order; sqlOrd contains the ORDER BY <col1>... piece of query:
sqlLista = "ListaAbonos"
ListaAbonos (Access query) =
SELECT Left('0000',4-Len(c.nro_cliente)) & c.nro_cliente & ' - ' & IIF(IsNull(razon_social),apellido & ' ' & nombre, razon_social), a.cod_localidad & '/' & cod_cobrador, cod_abono, descripcion, tel_verificacion, fecha_alta, a.direccion, s.nombre_servicio, ts.valor, a.estado
FROM ((abonos AS a
INNER JOIN servicios AS s ON a.cod_servicio = s.cod_servicio)
INNER JOIN tarifas_servicio AS ts ON a.cod_servicio = ts.cod_servicio)
INNER JOIN clientes AS c ON a.nro_cliente = c.nro_cliente;
sqlOrd = "ORDER BY..."
[NOTE: I ran the entire query (SELECT...ORDER BY...) and IT WORKS PROPERLY]
DECLARATIONS
Public Sub ordenar(ByVal sqlLista As Variant, ByVal sqlOrd As Variant)
Dim cs As String
Dim sPath As String
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim qd As DAO.QueryDef
CONNECTION TO DB:
sPath = "C:\Users\Ezequiel\Documents\ZEN.accdb"
cs = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sPath & ";Persist Security Info=False;"
Set cn = New ADODB.Connection
cn.Open cs
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
End With
THIS IS THE IMPORTANT PART OF THE CODE:
Set qd = CurrentDb.QueryDefs(sqlLista)
sql = Left(qd.sql, Len(qd.sql) - 1) & " " & sqlOrd
Set rs = cn.Execute(sql)
When I execute the Sub, I get an error
Characters found after end of sql statement
Inspecting "sql" and "qd.sql" I found that the query had been truncated:
sql = qd.sql = "SELECT Left('0000',4-Len(c.nro_cliente)) & c.nro_cliente & ' - ' & IIF(IsNull(razon_social),apellido & ' ' & nombre, razon_social), a.cod_localidad & '/' & cod_cobrador, cod_abono, descripcion, tel_verificacion, fecha_alta, a.direccion, s.nombre_serv
Note that the ORDER BY doesn't even appear as it's beyond the first 255 chars.
What's the problem? Thanks!
My team and I support a large network of MS access applications. Recently we upgraded our Microsoft Office from 2010 to 2013. The only thing that broke in this upgrade was our ability to sort/filter datasheets that are populated from an ADO RecordSet. Attempting to filter results in an error
Data Provider could not be initialized
From my research I understand that Microsoft considers ADO deprecated and has stopped supporting ADO as a means of populating RecordSets.
I'm however in a specific bind and have been trying every "fix" I could find in order to get this datasheet filterable. I am open to all suggestions.
The closest I have gotten is by populating the datasheet via a stored procedure:
Dim cn As New ADODB.connection
Dim cm As New ADODB.Command
Set cn = New ADODB.connection
With cn
.Provider = "Microsoft.Access.OLEDB.10.0"
.Properties("Data Provider") = "SQLNCLI10"
.Properties("Data Source") = "ascsql2012sbox"
.Properties("Integrated Security") = "SSPI"
.Properties("Initial Catalog") = "assetQuality_dev"
End With
cn.Open
Dim rs As ADODB.recordset
Set rs = New ADODB.recordset
With cm
.ActiveConnection = cn
.CommandText = "dbo.accountIDproc"
.CommandType = adCmdStoredProc
.parameters.Refresh
End With
With rs
.ActiveConnection = cn
.CursorType = adOpenForwardOnly
.CursorLocation = adUseClient
End With
Set rs = cm.Execute
cm.ActiveConnection = Nothing
Set Me.recordset = rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
But the same error
Data provider could not be initialized
is still showing up whenever I try to sort a column from A-Z or Z-A. For some columns that contain an integer value. It asks me for a value to sort by then tells me "that's not a valid value" when it's absolutely a valid value.
Thank you for your time.
I ended up answering my own question with a pretty solid solution as suggested by #parfiat
I created a temp table then inserted values from a recordset. I then set the temp table to the DAO.recordset which my datasheet pulls from. Here's my coded solution:
Set rs = New ADODB.recordset
Set cn2 = New ADODB.connection
With cn2
.Provider = "Microsoft.Access.OLEDB.10.0"
.Properties("Data Provider") = "SQLNCLI10"
.Properties("Data Source") = "ascsql2012sbox"
.Properties("Integrated Security") = "SSPI"
.Properties("Initial Catalog") = "assetQuality_dev"
End With
cn2.Open
cn2.CommandTimeout = 0
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.CursorType = adOpenKeyset
rs.Source = "SELECT " & sqlSelect & " FROM " & sqlFrom & IIf(sqlWhere <> "", " WHERE " & sqlWhere, "") & IIf(sqlOrder <> "", " ORDER BY " & sqlOrder, "")
Set rs.ActiveConnection = cn2
rs.Open
If AccessTableExists("ThisTable") = True Then
DoCmd.DeleteObject acTable = acDefault, "ThisTable"
End If
' Create temp table
Dim dbs As Database
' on your computer
Set dbs = CurrentDb
' Create a table with two text fields.
dbs.Execute "CREATE TABLE ThisTable " _
& "(accountID int, customerName CHAR, phoneHome VARCHAR(25), taxID VARCHAR(9), address VARCHAR(200), addressState VARCHAR(2), addressCity VARCHAR(2), bank VARCHAR(35), dateReview VARCHAR(200), orderDateReview VARCHAR(100), dateDue VARCHAR(100), balCustomer VARCHAR(200), activityCode VARCHAR(100), dateActivity VARCHAR(100), accountNumber VARCHAR(25));"
dbs.Close
Dim dbsTemp As DAO.Database
Dim rstemp As DAO.recordset
Set dbsTemp = CurrentDb
Set rstemp = dbsTemp.OpenRecordset("ThisTable", dbOpenDynaset)
Do While Not rs.EOF
rstemp.AddNew
rstemp!accountID.value = rs!accountID.value
rstemp!customerName.value = rs!customerName.value
rstemp!balCustomer.value = rs!balCustomer.value
rstemp!accountNumber.value = rs!accountNumber.value
rstemp!dateDue.value = rs!dateDue.value
rstemp!taxID.value = rs!taxID.value
rstemp!phoneHome.value = rs!phoneHome.value
rstemp!dateReview.value = rs!dateReview.value
rstemp!activityCode.value = rs!activityCode.value
rstemp!dateActivity.value = rs!dateActivity.value
rstemp.update
rs.MoveNext
Loop
Set Me.recordset = rstemp
rs.Close
Set rs = Nothing
cn2.Close
Set cn2 = Nothing
I have an old program I'm looking to convert from VB6 to VB.NET
Here's the code:
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
Dim rs As New ADODB.Recordset
cnn.CursorLocation = adUseClient
cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\TestDB.mdb" & "; Persist Security Info=False;"
cnn.Open
rs.Open "SELECT Addresses.*, Accounts.[Login Status], * FROM Accounts INNER JOIN Addresses ON Accounts.AccountID = Addresses.AccountID WHERE (((Accounts.[Login Status])=Yes))", cnn, adOpenStatic, adLockReadOnly
rs.AbsolutePosition = 1
lblFirstName.Caption = rs![Addresses.First Name]
lblLastName.Caption = rs![Addresses.Last Name]
lblAddress.Caption = rs![Address]
lblPSPR.Caption = rs![Parish/State/Province/Region]
lblZipCode.Caption = rs![Zip Code]
lblCountry.Caption = rs![Country]
lblTelephoneNumber.Caption = rs![Addresses.Telephone Number]
lblCellNumber.Caption = rs![Addresses.Cell Number]
lblAddressID.Caption = rs![AddressID]
cnn.Close
Now the code I here passes the sql result to the labels mentioned above and by changing the rs.AbosolutePosition i can either display the 1st row, 2nd row, 3rd row etc. Now my question is how to i accomplish this in VB.NET ?