I would like to build a SQL request in order to store all my sheet content into an access DB in order to do this I built the following request :
sSQL = "INSERT INTO Archive_FP21 (Date_Histo,Caisse,Libelle,Reference_Contrat,Date_de_Nego,Date_Valeur,Echeance_Finale,Libelle_Index,Taux_Actuel,Capital_Origine,Capital_Restant_Du,Marge,Taux_du_cap,Taux_du_Floor,Derniere_Echance_INT,Derniere_Echeance_AMO,Interet,Prochaine_Echeance) " & _
"SELECT * FROM [Feuil1$A:R] IN """ & WbPath & """"
But I am facing the following issue :
3343 unrecognized database format
[I feel like my issue is in FROM [Feuil1$A:R] IN """ & WbPath & """"]
Below is the my full code Sub :
Sub archiver()
Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim sDb As String
Dim sSQL As String
Dim qdf As QueryDef
Dim WbPath As String
WbPath = "C:\******\Extraction FP21 Mise en Forme Auto\16102020 - Copie.xlsx"
sDb = "C:\******\BaseFp21.accdb"
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(sDb)
sSQL = "INSERT INTO Archive_FP21 (Date_Histo,Caisse,Libelle,Reference_Contrat,Date_de_Nego,Date_Valeur,Echeance_Finale,Libelle_Index,Taux_Actuel,Capital_Origine,Capital_Restant_Du,Marge,Taux_du_cap,Taux_du_Floor,Derniere_Echance_INT,Derniere_Echeance_AMO,Interet,Prochaine_Echeance) " & _
"SELECT * FROM [Feuil1$A:R] IN """ & WbPath & """"
db.Execute sSQL
End Sub
Note The goal of this SQL request is to Add all data from the sheet 'Feui1.Range(A:R)` into my Access Table.
I can't do it row By Row since I have 37K line to fill in Access.
What Am I missing ? How would you do in order to fill 37K row from excel inside Access DB with VBA ?
To query from an Excel workbook inline with an Access connection does not use the IN operator but bracketed identifier with set parameters such as headers and workbook type. As used, IN would work if you were querying an external Access database but being an Excel workbook, the database format was not recognized.
sSQL = "INSERT INTO Archive_FP21 (Date_Histo, Caisse, Libelle, Reference_Contrat," _
& " Date_de_Nego, Date_Valeur, Echeance_Finale, " _
& " Libelle_Index, Taux_Actuel, Capital_Origine, " _
& " Capital_Restant_Du, Marge, Taux_du_cap, Taux_du_Floor, " _
& " Derniere_Echance_INT, Derniere_Echeance_AMO, Interet, " _
& " Prochaine_Echeance) " _
& " SELECT * FROM [Excel 12.0 Xml;HDR=Yes;Database=" & WbPath & "].[Feuil1$A:R]"
db.Execute sSQL
Also, be sure to avoid SELECT * FROM and explicitly select named columns especially in insert-select append queries for column-to-column mapping. SELECT Col1, Col2, Col3, ... FROM is more readable and maintainable in case Excel columns order should adjust or some columns are no longer present.
Related
I have a table in excel that has multiple lines per date. I'd like to create a new table that groups by date as well as a few other dimensions and sums net_revenue.
In sql it would be simple:
SELECT send_date,
week_day,
after_hours,
discount_type,
sum(net_revenue
FROM this_table
GROUP BY send_date,
week_day,
after_hours,
discount_type
Is there a simple way to do this in excel? At first I thought pivot tables but I don't want each additional dimension on a new row.
This is what my current table looks like:
Consider the following strictly GUI interface solution:
Copy all your grouping fields as is into a separate sheet.
Under Data tab of ribbon, click Remove Duplicates, selecting all columns.
In the final column, run SUMIFS formula to calculate net_revenue sum, pointing to values in you original sheet.
=SUMIFS(<net_revenue_column>,
<1stgroup_column_in_first_sheet>, <1stgroup_value_in_second_sheet>,
<2ndgroup_column_in_first_sheet>, <2ndgroup_value_in_second_sheet>,
<3rdgroup_column_in_first_sheet>, <3rdgroup_value_in_second_sheet>,
...
)
Alternatively, actually run SQL (if using Excel for Windows) using the JET/ACE SQL Engine (same engine of MS Access that can query Excel workbooks even CSV files). Below assumes your data begins in A1 with named columns. Adjust sheet name in FROM clause.
Sub RunSQL()
Dim oConn, rs As Object
Dim strConnection, strSQL As String
Dim i As Integer
Set oConn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
' CONNECTION STRING ON CURRENT WORKBOOK
strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
& "DBQ=" & ThisWorkbook.FullName & ";"
' OPEN DB CONNECTION
oConn.Open strConnection
strSQL = "SELECT send_date, " _
& " week_day, " _
& " after_hours, " _
& " discount_type, " _
& " sum(net_revenue) AS total_revenue " _
& " FROM [SheetName$] " _
& " GROUP BY send_date, " _
& " week_day, " _
& " after_hours, " _
& " discount_type "
' OPEN RECORDSET OF QUERY
rs.Open strSQL, oConn
' OUTPUT DATA TO EXCEL WORKSHEET (IN EMPTY TAB NAMED "RESULTS")
' HEADERS
For i = 0 To rs.Fields.Count - 1
ThisWorkbook.Worksheets("RESULTS").Cells(1, i) = rs.Fields(i).Name
Next i
' ROWS
ThisWorkbook.Worksheets("RESULTS").Range("A2").CopyFromRecordset rs
rs.Close: oConn.Close
Set rs = Nothing: Set oConn = Nothing
End Sub
We have been creating a HR Database using Access as the back-end and Excel as the front-end. When I run my macro in Excel to insert entries into the MasterTable it says; "Data Type Mismatch". The only field that I had changed was the "Job" Field which required a value between 0.0 - 1.0 (i.e. 0.2 means they are only working one day).
Previously when I inserted entries in the decimal place would not show until I changed the field type in Access to accept decimals. After this change, the macro no longer works.
Can anyone point out why this is?
I have only just started learning SQL/Access so it is very likely I made a very basic mistake.
I searched up on SO a few other answers which talked about using the DECIMAL field instead of changing the properties field but this didn't solve my issue. My code:
Sub ExportDataToAccess()
Dim cn As Object
Dim strQuery As String
Dim Id As String
Dim Positions As String
Dim BU As String
Dim Job As Double
Dim Variance As String
Dim myDB As String
'Initialize Variables
Id = Worksheets("test").Range("A2").Value
Positions = Worksheets("test").Range("B2").Value
BU = Worksheets("test").Range("C2").Value
Job = Worksheets("test").Range("D2").Value
myDB = "X:\Users\ADMIN\Documents\HR_Establishment_DB1.accdb"
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0" 'For *.ACCDB Databases
.ConnectionString = myDB 'Connects to my DB
.Open
End With
strQuery = "INSERT INTO MasterTable ([Id], [Positions], [BU], [Job]) " & _
"VALUES (""" & Id & """, """ & Positions & """, """ & BU & """, " & Job & "); "
cn.Execute strQuery
cn.Close
Set cn = Nothing
End Sub
Do you intend the value of ID to be obtained from the excel (Id = Worksheets("test").Range("A2").Value)?
I think it is causing the error. If a field on access is of AutoNumber data type, you don't have to include it on your INSERT query as access automatically assigns a value for this in incremental manner.
If you want access to automatically assign a value for ID, change this:
strQuery = "INSERT INTO MasterTable ([Id], [Positions], [BU], [Job]) " & _
"VALUES (""" & Id & """, """ & Positions & """, """ & BU & """, " & Job & "); "
to this:
strQuery = "INSERT INTO MasterTable ([Positions], [BU], [Job]) " & _
"VALUES (""" & Positions & """, """ & BU & """, " & Job & "); "
I need some help. When i run the below query I get no results back if i include the Pkg number part of the where. When i run the query in Access it works fine.
example of vars
package number 1_282
Rptdt 201301
Dim db As Database 'generic database object
Dim rst As Recordset 'this is going to hold the query result
Set db = CurrentDb
Dim PKG As Double
Dim rptDT As Double
Dim wireDT As Date
Set rst = db.OpenRecordset("SELECT Max(tbl_Revision.Revision_Number) as Revision_Number FROM tbl_Revision" & _
" where (tbl_Revision.RUN_YR_MO=" & rptDT & ")" & _
" and (tbl_Revision.Package_Number=" & PKG & ")")
getRevision = rst!Revision_Number + 1
The PKG cant be a Double if you want 1_282 to work. So make it a string.
Also you will have to add quotes :
" where (tbl_Revision.RUN_YR_MO='" & rptDT & "')" & _
I've been given an Access database which includes 12 tables of data that each contain around 200,000 rows. Each of these tables contain monthly data on about 200 buildings. I don't want to spend a lot of time normalizing the database, I just wrote a quick script to create a table for each building from this data.
Having said all that, my code is taking about 1.5 hours to run. Is there anything I can do to speed this up, or am I just reaching the limits of what Access is capable of? Any suggestions will be appreciated.
Sub RunQueryForEachBuilding()
Dim RRRdb As DAO.Database
Dim rstBuildNames As DAO.Recordset
Dim rstDataTables As DAO.Recordset
Dim rstMonthlyData As DAO.Recordset
Dim strSQL As String
Dim sqlCreateT As String
Dim sqlBuildData As String
Dim strDataTable As String
Dim sqlDrop As String
On Error GoTo ErrorHandler
'open recordsets for building names and datatables
Set RRRdb = CurrentDb
Set rstBuildNames = RRRdb.OpenRecordset("BuildingNames")
Set rstDataTables = RRRdb.OpenRecordset("DataTables")
Do Until rstBuildNames.EOF
' Create a table for each building.
' Check if table exists, if it does delete and recreate.
If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & rstBuildNames.Fields("BuildingPath") & "'")) Then
' Table Exists - delete existing
sqlDrop = "DROP TABLE [" & rstBuildNames.Fields("BuildingPath") & "]"
RRRdb.Execute sqlDrop
' re-create blank table
End If
'create table for this building
sqlCreateT = "CREATE TABLE [" & rstBuildNames.Fields("BuildingPath") & _
"] (BuildingPath VARCHAR, [TimeStamp] DATETIME, CHWmmBTU DOUBLE , ElectricmmBTU DOUBLE, kW DOUBLE, kWSolar DOUBLE, kWh DOUBLE, kWhSolar DOUBLE)"
RRRdb.Execute sqlCreateT
'populate data from monthly table into the building name table.
Do While Not rstDataTables.EOF
' get data from each monthly table for this building and APPEND to table.
strDataTable = rstDataTables.Fields("[Data Table]")
'Debug.Print strDataTable
'create a SQL string that only selects records that are for the correct building & inserts them into the building table
sqlBuildData = "INSERT INTO [" & rstBuildNames.Fields("BuildingPath")
sqlBuildData = sqlBuildData & "] ([TimeStamp], [CHWmmBTU], [ElectricmmBTU], kW, [kWSolar], kWh, [kWhSolar], BuildingPath) "
sqlBuildData = sqlBuildData & " SELECT [TimeStamp], [CHW mmBTU], [Electric mmBTU], kW, [kW Solar], kWh, [kWh Solar], BuildingPath FROM "
sqlBuildData = sqlBuildData & rstDataTables.Fields("[Data Table]") & " WHERE BuildingPath LIKE '*" & rstBuildNames.Fields("BuildingPath") & "'"
'Debug.Print sqlBuildData
RRRdb.Execute sqlBuildData
rstDataTables.MoveNext
Loop
rstBuildNames.MoveNext
rstDataTables.MoveFirst
Loop
Set rstBuildNames = Nothing
Set rstDataTables = Nothing
ErrorHandler:
'MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Sub
That code drops and then re-creates rstBuildNames.Fields("BuildingPath") with the same structure. It should be faster to just empty out the table:
"DELETE FROM " & rstBuildNames.Fields("BuildingPath")
However that is not likely to speed up the operation enough.
The WHERE clause of the INSERT query forces a full table scan ...
" WHERE BuildingPath LIKE '*" & rstBuildNames.Fields("BuildingPath") & "'"
If you can use an exact string match instead of a Like comparison, and create an index on BuildingPath, you should see a significant improvement.
" WHERE BuildingPath = '" & rstBuildNames.Fields("BuildingPath") & "'"
I will suggest dbOpenSnapshot, too, even though it won't make a noticeable difference since you're only opening the recordsets one time. (It may not help, but it won't hurt.)
Set rstBuildNames = RRRdb.OpenRecordset("BuildingNames", dbOpenSnapshot)
Set rstDataTables = RRRdb.OpenRecordset("DataTables", dbOpenSnapshot)
I extract data from my Access database into an Excel worksheet using a macro. I first open a connection to the database, define my sql statement in a string var and then dump that data in a recordset:
Dim db As Database
Dim rs As RecordSet
Dim sql As String
Dim dbLocation As String
dbLocation = ThisWorkbook.Path & "\database\data.accdb"
Set db = OpenDatabase(dbLocation)
sql = "Select * FROM [Master Table]"
Set rs = db.OpenRecordSet(sql, dbOpenSnapshot)
If Not rs.EOF Then
Worksheets("Sheet1").Range("A1").CopyFromRecordset rs
End If
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
This works perfectly. I distribute this to some people and ask them to update fields. I then need to update the Access data with data that is passed back. The simple thing in terms of design is that the extracted excel data mirrors the access db in structure so the update query should be simple. Also there is a primary key, so I would just need to map on that field.
Any ideas how this can be done? Can I load the whole excel datasheet into a recordset and run some snazzy update query?
You need to loop over rows on sheet 1, and for each row make sql string that looks like:
"update [Master table] set
TableField1 = " & Range(Row, Col1).Value & ","
TableField2 = " & Range(Row, Col2).Value & ","
...
where IDTableField = " & Range(Row, IDColNum).Value
and then do
db.Execute thatString
PS: There are may be mistakes in my syntax. And you need to convert cell values to strings when making string.
An extension of shibormot's solution using DAO:
Set objConnection = CreateObject("DAO.DBEngine.36")
Set db = objConnection.OpenDatabase(strDBPath, blnExclusive, blnReadOnly, strPassword)
For Each row In Range("A1:C3").Cells
strSQL = "UPDATE table SET "
strSQL = strSQL & "Field1 = " & Chr(34) & row.Cells(1) & Chr(34) & ","
strSQL = strSQL & "Field2 = " & Chr(34) & row.Cells(2) & Chr(34) & ","
strSQL = strSQL & "Field3 = " & Chr(34) & row.Cells(3) & Chr(34)
Db.Execute
Next
Threw in the chr(34) for string data