I have an issue while trying to get every line from a table in my database. In VBA when requesting the table with 'SELECT * FROM companies;', the results duplicates the first row, and remove the last one. As a result, I have 3 records, which corresponds to the real number of records in my DB, but instead of having 1, 2 and 3, I have 1, 1 and 2.
Any idea?
You can see here Database records for table 'companies', when requesting 'SELECT * FROM companies': DB Records
You can see here the result of the same request in Excel/VBA using the following code:
sqlQuery = "SELECT ALL * FROM companies;"
rsDB.Open sqlQuery, conDB, adOpenDynamic
Do While Not rsDB.EOF
For Each col In rsDB.GetRows
Debug.Print col
Next
Loop
Results: VBA request
Would love to get any piece of advice on this issue!
The fun fact is that if I try to select only one column of the table, such as 'idCompany', then I have the result '1, 2, 3' with VBA, which is fine. The real issue only appears when using '*'.
Thanks a lot for your time,
--- EDIT
The connection string used to connect to the DB:
Set conDB = New ADODB.Connection
Set rsDB = New ADODB.recordSet
Set rsDBCol = New ADODB.recordSet
conDB.connectionString = "DRIVER={MariaDB ODBC 3.1 Driver};" _
& "SERVER=s-mypricing-1;" _
& "DATABASE=db_pricing;" _
& "PORT=3306" _
& "UID=user;" _
& "PWD=pwd;" _
& "OPTION=3"
conDB.Open
rsDB.CursorLocation = adUseServer
rsDBCol.CursorLocation = adUseServer
Difficult to test, but I suspect you need this instead:
rsDB.MoveFirst
Do While Not rsDB.EOF
For Each fld In rsDB.Fields
Debug.Print fld.Name & ": " & fld.Value
Next
rsDB.MoveNext
Loop
When you iterate an ADO recordset, the object itself represents a current row. So you refer to the Fields of the current row to get the columns. And the properties of each field to get descriptive information about that cell (name of column, value in cell).
Through the comments we learned that the issue is related to opening the recordset with adOpenDynamic mode. What follows is code that should represent a working case for MaraiaDB.
Set conDB = New ADODB.Connection
Set rsDB = New ADODB.recordSet
Set rsDBCol = New ADODB.recordSet
conDB.connectionString = "DRIVER={MariaDB ODBC 3.1 Driver};" _
& "SERVER=s-mypricing-1;" _
& "DATABASE=db_pricing;" _
& "PORT=3306" _
& "UID=user;" _
& "PWD=pwd;" _
& "OPTION=3"
conDB.Open
rsDB.CursorLocation = adUseServer
rsDBCol.CursorLocation = adUseServer
sqlQuery = "SELECT ALL * FROM companies;"
With rsDB.Open(sqlQuery, conDB)
If Not (.BOF And .EOF) Then
.MoveFirst
Do Until .EOF
For Each fld In .Fields
Debug.Print fld.Name & ": " & fld.Value
Next
.MoveNext
Loop
End If
.Close
End With
conDB.Close
Related
I have a central database that is kept on a network that stores part numbers & descriptions for various components for machines. Often times individuals will need to use an offline copy during design and will add new entries to it. Is there a script to find the differences and update the master file that is on the network? I played around with union queries but I'm struggling to be able to update the original file and original table. My sql/microsoft access knowledge is limited.
For sake of clarity let's call the files as such:
Network Database: Network_DB.mdb
Offline Database: Offline_DB.mdb
Table: MISC_CAT
In my experience a generic solution is pretty difficult. I tend to store the field names I want in a table then run the relevant update:
Public Function UpdateData()
Dim db As Database
Dim qd As QueryDef
Dim rs As Recordset
Dim strSQL As String
On Error GoTo Err_UpdateData
Set db = CodeDb
strSQL = "SELECT fldName FROM MyTables WHERE tblName = 'MISC_CAT'"
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
Do Until rs.EOF
strSQL = "UPDATE MISC_CAT_Network INNER JOIN MISC_CAT_Offline ON MISC_CAT_Network.KeyID = MISC_CAT_Offline.KeyID " & _
"SET MISC_CAT_Network.[" & rs!fldName & "] = [MISC_CAT_Offline].[" & rs!fldName & "] " & _
"WHERE (((Nz([MISC_CAT_Network].[" & rs!fldName & "],''))<>Nz([MISC_CAT_Offline].[" & rs!fldName & "],'')))"
db.Execute strSQL, dbFailOnError
rs.MoveNext
Loop
db.Execute strSQL, dbFailOnError
rs.Close
db.Close
Exit_UpdateData:
Set rs = Nothing
Set qd = Nothing
Set db = Nothing
Exit Function
Err_UpdateData:
Debug.Print "Error - " & Err.Number & " - " & Err.Description
Resume Exit_UpdateData
End Function
I have a database containing locations of water wells and a ton of properties associated with those wells. All tables are linked with WELL_ID (name of the well), which is "short text" data type, from what I can tell. Within the database there are existing queries from which I'm trying to get the data (I don't want to mess with the tables in case I make a mistake and mess something up).
I've created a form where the user inputs UTM coordinates for easting and northing, as well as a search radius, then clicks a "search" button. Upon clicking search, the procedure creates a recordset of the [qryUTM_NAD83], then calculates the radial distance of each well and if it is within the specified search radius, it is stored in a new [Search_Results] table using INSERT INTO.
Now, once the well is identified as meeting search criteria the WELL_ID is stored, and passed to a function which searches through a recordset of a different query [qryFormation]. This query has a one-to-many relationship where there is a record for each geologic layer, each having the same WELL_ID (i.e. each well has multiple layers but all these layers have the same WELL_ID). I need to concatenate these layers into one string, pass them back to the search function and add it to the [Search_Results] table. However, i get a data type mismatch error in the SQL statement.
Here's the code I have:
(I've omitted some parts of code to keep it short for you all)
Private Sub SearchButton_Click()
Dim WellID As String, mySQL As String, NewLitho As String
'Creating new recordsets from [qryUTM_NAD83] table
Dim rs1 As DAO.Recordset
'[ZONE] is just user specified, helps me narrow the search a little
Set rs1 = CurrentDb.OpenRecordset("SELECT [qryUTM_NAD83].* " & _
"FROM [qryUTM_NAD83] " & _
"WHERE [ZONE] = " & frmZone, dbOpenDynaset)
'Moving through the recordset
rs1.MoveFirst
Do While Not rs1.EOF
'calculated radius, r , for this well (omitted)
If r < SearchRadius Then
WellID = Val(rs1.Fields("WELL_ID").Value)
NewLitho = LithoTransform(WellID)
mySQL = "INSERT INTO [Search_Results] " & _
"([WELL_ID], [Easting], [Northing], [Radius], [Lithology]) " & _
"VALUES (" & WellID & ", " & x & ", " & y & ", " & r & ", " & NewLitho & ")"
CurrentDb.Execute mySQL
rs1.MoveNext
End If
Loop
End Sub
The function:
(error occurs in "Set rs2..." - data type mismatch)
Public Function LithoTransform(CurrentID As String) As String
'CurrentID is the well which was identified as being within the search radius
Dim rs2 As DAO.Recordset
Dim mySQL2 As String
'SQL statement and new recordset of the well we are looking at in the search
Debug.Print CurrentID
mySQL2 = "SELECT [qryFormation].* " & _
"FROM [qryFormation] " & _
"WHERE [WELL_ID] = " & CurrentID
Set rs2 = CurrentDb.OpenRecordset(mySQL2, dbOpenDynaset)
'Move through recordset rs2 and concatenating into new string
'Bunch of code here
'Close recordset set it to 'nothing'
End Function
Since WELL_ID is text type, include quotes around the value of CurrentID when you include it in your WHERE clause. So the quickest fix is probably this ...
mySQL2 = "SELECT [qryFormation].* " & _
"FROM [qryFormation] " & _
"WHERE [WELL_ID] = '" & CurrentID & "'"
However, you could switch to a parameter query instead and thereby avoid issues with quotes. Here is an untested example ...
Dim db As DAO.Database
Dim qdf AS DAO.QueryDef
Dim rs2 As DAO.Recordset
Dim mySQL2 As String
mySQL2 = "SELECT [qryFormation].* " & _
"FROM [qryFormation] " & _
"WHERE [WELL_ID] = [which_id]"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, mySQL2)
qdf.Parameters("which_id") = CurrentID
Set rs2 = qdf.OpenRecordset
Use the Access help system to check functions, syntax, etc. in that code in case I made errors. Since you're new to Access, it will be to your advantage to get comfortable with its help system.
I want to apply an SQL query to one Access table, from which it is retrieving data from a table in another Access file. I've looked around on this subject and can't seem to get solutions to work.
Based on this source http://support.microsoft.com/kb/113701, I came up with the following, but still have no luck.
sSQL = "UPDATE TableInCurrentDB
SET [Field1InCurrentDB]= DAvg('Field1InExternalDB','[;database=C:\VB\ExternalDB.accdb].[TableInExternalDB]','Field2InExternalDB= & Year(Now()) & ')
WHERE [Field2InCurrentDB]='1';"
DoCmd.RunSQL sSQL
I know that the error lies somewhere in the reference to the external DB, because the code works fine if the tables are in the same database. However, it's tough to tell exactly what's wrong because the error I get is 'Unknown'.
How can I modify this statement to update an Access table from another Access database's table?
You prefer not to use a link to the table in the external database, but that choice is a complication when you want to use DAvg. However, since you're doing this with VBA code, you can ditch DAvg and do what you need in 2 steps:
First retrieve the average from the external table.
Use that step #1 average in your UPDATE.
For step #1, test this as a new query in the Access query designer ...
SELECT Avg(Field1InExternalDB)
FROM TableInExternalDB IN 'C:\VB\ExternalDB.accdb'
WHERE Field2InExternalDB=Year(Date());
Assuming that query returns the correct value, adapt your VBA code to retrieve the same value.
Dim db As DAO.database
Dim strSelect As String
Dim varAvg As Variant
strSelect = "SELECT Avg(Field1InExternalDB)" & vbCrLf & _
"FROM TableInExternalDB IN 'C:\VB\ExternalDB.accdb'" & vbCrLf & _
"WHERE Field2InExternalDB=Year(Date());"
'Debug.Print strSelect
Set db = CurrentDb
varAvg = db.OpenRecordset(strSelect)(0)
Debug.Print Nz(varAvg, 0) ' see note
Note that query will return Null when no rows include Field2InExternalDB values which match the current year. That is why varAvg is declared as Variant. Later Nz(varAvg, 0) will give you zero instead of Null.
Then you can use a parameter query for your UPDATE and supply Nz(varAvg, 0) as the parameter value.
Dim qdf As DAO.QueryDef
Dim strUpdate As String
strUpdate = "UPDATE TableInCurrentDB" & vbCrLf & _
"SET [Field1InCurrentDB]=[pAvg]" & vbCrLf & _
"WHERE [Field2InCurrentDB]='1';"
'Debug.Print strUpdate
Set qdf = db.CreateQueryDef(vbNullString, strUpdate)
qdf.Parameters("pAvg") = Nz(varAvg, 0)
qdf.Execute dbFailOnError
Set qdf = Nothing
Set db = Nothing
Could you not do this as a single step? Incorporate the output of the first SQL as the input to the "set" in the second?
In other words,bypass the first query and just do the second using this as the "strUpdate" string:
strUpdate = "UPDATE TableInCurrentDB" & vbCrLf & _
"SET [Field1InCurrentDB]=" & vbCrLf & _
" (SELECT Val(Nz(Avg(Field1InExternalDB),0))" & vbCrLf & _
" FROM TableInExternalDB IN 'C:\VB\ExternalDB.accdb'" & vbCrLf & _
" WHERE Field2InExternalDB=Year(Date()) )" & vbCrLf & _
"WHERE [Field2InCurrentDB]='1';"
I have created the code below to test whether I can run a query and retrieve a data from an SQL server table. And so far I can return the result using a MessageBox, but somehow I just don't know how to use this connection to update the table inside this Access file. Basically I want to use this as a front end file. Then, when the form is open it will automatically update the table inside this access file and load the data to the combo box as a list. I tried searching it here and read many discussions here and in Google but currently I can't find the right solution.
Option Compare Database
Sub LocalServerConn_Test()
Set conn = New adodb.Connection
Set rst = New adodb.Recordset
strDBName = "DataSet"
strConnectString = "Provider = SQLOLEDB.1; Integrated Security = SSPI; " & _
"Initial Catalog = " & strDBName & "; Persist Security Info = True; " & _
"Worksation ID = abc123;"
conn.ConnectionString = strConnectString
conn.Open
strSQL = "SELECT DISTINCT dbo.abc.abc123 FROM dbo.abc"
rst.Open Source:=strSQL, ActiveConnection:=strConnectString, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic
If rst.RecordCount = 0 Then
MsgBox "No records returned"
Else
rst.MoveFirst
Do While Not rst.EOF
MsgBox rst.Fields("abc123").Value
rst.MoveNext
Loop
End If
conn.Close
rst.Close
End Sub
You should be able to use code very similar to this:
Dim cdb As DAO.Database
Set cdb = CurrentDb
cdb.Execute _
"DELETE FROM LocalTable", _
dbFailOnError
cdb.Execute _
"INSERT INTO LocalTable (abc123) " & _
"SELECT DISTINCT abc123 " & _
"FROM " & _
"[" & _
"ODBC;" & _
"Driver={SQL Server};" & _
"Server=.\SQLEXPRESS;" & _
"Database=DataSet;" & _
"Trusted_Connection=yes;" & _
"].[dbo.abc]", _
dbFailOnError
Set cdb = Nothing
You can just keep the combo box bound to [LocalTable] and the updated values from the SQL Server table should appear.
I have a table in Access 2003 that has the following fields
Ptr_RateTable
MinOfWeight_Up_To
Adder
I need to find the unique values for MinOfWeight_Up_To for any table, without showing the table names in my results. I am trying to condense tables sizes in the mainframe by finding tables that can be condensed at the same weight breaks.
So for example
Ptr_RateTable|MinOfWeight_Up_To
1109LW020|1.00
1109LW020|2.00
1109LW020|6.00
1109LW020|11.00
1109LW020|101.00
1109LW020|128.00
1109LW020|129.00
1109LW021|1.00
1109LW021|2.00
1109LW021|3.00
1109LW021|11.00
1109LW021|36.00
1109LW021|41.00
1109LW021|151.00
I would like to see the following as a result and not make another "Profile" with the same weight breaks
Profile1|1.00|2.00|6.00|11.00|101.00|128.00|129.00
Profile2|1.00|2.00|3.00|11.00|36.00|41.00|151.00
First, you need a function that produces a signature for that table. Something akin to:
Public Function GetSignature(sTableName As String) As String
Dim oDB As DAO.Database
Dim oRS As DAO.Recordset
Dim sSQL As String
Dim sResult As String
sSQL = "Select Distinct MinOfWeight_Up_To" _
& vbCrLf & "From [" & sTableName & "]"
& vbCrLf & "Order By MinOfWeight_Up_To"
Set oDB = DBEngine.Workspaces(0).Databases(0)
Set oRS = oDB.OpenRecordset(sSQL, dbOpenForwardOnly, dbReadOnly)
Do Until oRS.EOF
sResult = sResult & "|" & Nz(oRS(0))
oRS.MoveNext
Loop
GetSignature = result
Set oRS = Nothing
Set oDB = Nothing
End Function
Once you have that, you would need another routine that assembles a list of the tables, calls the above signature for each table and stores the result in a temporary table. You would then query that temporary table for the unique list of signatures.
It should be noted that gazillions of string concatenations will be very slow. Instead you should look for implementations of a more efficient string builder class that you can use to build the signatures.
Using a crosstab query:
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
sSQL = "TRANSFORM Min(s.MinOfWeight_Up_To) AS Min_Weight " _
& "SELECT 'Profile' & Right([Ptr_RateTable],2) AS Profile " _
& "FROM Sample s " _
& "GROUP BY s.Ptr_RateTable " _
& "PIVOT s.MinOfWeight_Up_To"
rs.Open sSQL, cn
astr = rs.GetString
Do While InStr(astr, Chr(9) & Chr(9)) > 0
astr = Replace(astr, Chr(9) & Chr(9), Chr(9))
Loop
Debug.Print astr