I have a subform named subform_View_Search and I Re-queried it based on some user's preference (e.g. filter or find latest date of specific item).
Now, I want to export this modified subform into an user preferred location. I have the following code but I am not sure if I am on the right track and this code
seems does not work ;~(
Private Sub Command_Excel_Inst_Click()
Dim Path As String
Path = CurrentProject.Path & "\" & "TempQueryName" & ".xls"
subform_View_Search.Form.RecordSource = SQL
subform_View_Search.Form.Requery
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "subform_View_Search", Path
End Sub
Your help will be appreciated !
This question is different than other questions because I am creating a excel file from SQL instead of from a query.
Here is my second try.
Here is the code of creating a temp query but there are 2 problems.
1. it gives a run time error 3066
2. My code seems doent work to delete the old temporary query
Dim db As Database
Dim Qdf As QueryDef
Dim strQry As String
Dim strSQL As String
Dim Path As String
Path = CurrentProject.Path & "\" & "TempQueryName" & ".xls"
strSQL = SQL '<-From public
strQry = "TempQueryName"
Set db = CurrentDb
Set Qdf = db.CreateQueryDef(strQry, strSQL)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strQry, Path
DoCmd.DeleteObject acQuery, strQry
You could try something like the following, not as easy as you want, but at first look its what I'd try. I'll continue to look though.
Dim f As Form
Dim x As Excel.Application
Set f = Me.Child0.Form
Set x = New Excel.Application
x.Visible = 1
x.Workbooks.Add
x.Worksheets(1).Range("a1").CopyFromRecordset f.Recordset
x.ActiveWorkbook.SaveAs "filename"
x.ActiveWorkbook.Close False
Set f = Nothing
Set x = Nothing
Or create a temp query with the same SQL, and then export this, then delete it. Not sure on what's allowed.
Related
I'm looking for a solution to import data from an Excel file into a database (for example: MS Access file).
I can get the idea as well as the structure but because I'm new to something like this it is really hard to finish the work.
Below is my code, which should do these:
Select database
Select import files
Create connection using ADODB
I'm stuck here, using Insert statement to import but how? Because the values to import would be a value of a variable run from the very first cell of Excel files till the end of it.
Please ignore the comment because I'm using my native language to easier understand in future
Sub Import_Data()
'Khai bao bien lien quan den Database
Dim connection As ADODB.connection
Dim record As ADODB.Recordset
'Khai bao cau lenh Query
Dim SQLstr As String
'Khai bao connection string
Dim connectionstring As String
Dim dbstring As String
'Duong dan den file import
Dim fdlg As FileDialog
Application.ScreenUpdating = False
'Chon datafile
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Access files", "*.accdb, *.mdb"
If .Show = True Then
datapath = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Chon file import
Set fdlg = Application.FileDialog(msoFileDialogFilePicker)
With fdlg
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel files", "*.xls,*.xlsx,*.xlsm"
If .Show = True Then
importstring = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Connect to Database
Set connection = New ADODB.connection
With connection
.Provider = "Microsoft.ACE.OLEDB.12.0"
.connectionstring = "Data Source=" & datapath & ";"
.ConnectionTimeout = 30
.Open
If .State = adStateOpen Then
MsgBox "welcome " & Environ("Username") & " ket noi den database"
Else: Exit Sub
End If
End With
Dim a, c As Integer
Dim b, d As Integer
Dim ImpWb As Workbook
Dim ImpWs As Worksheet
Set ImpWb = Application.Workbooks.Open(importstring)
ImpWb.Application.Visible = True
Set ImpWs = ImpWb.Worksheets("Sheet1")
With ImpWs.UsedRange
a = .Rows.Count
b = .Columns.Count
For c = 2 To a
For d = 1 To b
SQLstr = "Insert into Test values(" & Cells(c, d).Value & ")"
connection.Execute SQLstr
Next d
Next c
End With
ImpWb.Close
connection.Close
Set ImpWs = Nothing
Set ImpWb = Nothing
Set connection = Nothing
End Sub
From the comments above it's become clearer now that the issue you face is how to build the SQL statements inside VBA. However, you are very much closer than you think.
This function below will build an insert statement for each row of data provided the columns in the Excel tab is exactly equal to and in exact order as the fields in the SQL table. It also will combine all the inserts into one statement so you can execute all the rows at once.
With ImpWs.UsedRange
a = .Rows.Count
b = .Columns.Count
For c = 2 To a
SQLstr = SQLstr & "INSERT INTO TEST VALUES("
For d = 1 To b
SQLstr = SQLStr & .Cells(c, d).Value & iif(d <> b, ",","")
Next d
SQLstr = SQLStr & ");"
Next c
End With
The other caveat is that assumes all fields are numerical. If you have some text fields you will have to add ' before and after each field, like ' & .Cells(c, d).Value & & '. If you know the columns that need text, you can modify the input with a Select Case on column number as needed.
Hi you recognize or discovered already the magic connection.execute function. Here is the music playing. All its need is a valid SQL string to insert. That's (nearly) all.
SQL Strings can be fired single by single or a bunch separated by a ";" at the end
INSERT INTO table1 (column1,column2 ,..)
VALUES
(value1,value2 ,...),
(value1,value2 ,...),
...
(value1,value2 ,...); --<<<<<<<<<<< see the ";"
In your case you has to define the affected columns in the first line and then just all the values for a line inside the braces. If this do not work - something is wrong with the SQL string. You can use access which has a nice SQL builder to create a sql template or maybe use a online sql tester to see if your sql is valid. For testing purposes i suggest to just add one line first. And another hint: The values has to be escaped ! So add first something trivial like "abc" or 1234 just to check out the principle function. Life datas might have things like this >"< inside or "," or other things which could be seen as sql statement. Which will end up like it will do nothing at all. So read the manual how access escaped such poisoned text fragments ;) And implement a function to avoid that. SQLITE has a nice tutorial and example page. SQLITE is nearly like access. To get a overview i would read there first and the M$ documentation a biut later. Have fun :)
There is also this approach using SQL
Sub test()
Dim c As ADODB.Connection
Dim s As String
Dim strSQL As String
s = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=c:\…...\TestDBs\API_TEST.accdb;" & _
"Persist Security Info=False;"
Set c = New ADODB.Connection
c.ConnectionString = s
c.Open
' Excel workbook, sheet name test1
strSQL = "INSERT INTO tblDestination ( Firstname )" & _
"SELECT [test1$].FirstName " & _
"FROM [EXCEL 12.0;HDR=YES;IMEX=2;DATABASE=C:\Databases\csv\test1.xlsx].[test1$];"
c.Execute strSQL
c.Close
End Sub
I want to export each table of one database in separate accdb files and I don't get it.
With the following code -> https://www.devhut.net/2012/09/27/ms-access-vba-export-database-objects-to-another-database/ the destination database must already exist.
How can I create e.g. for table1 the file table1.accdb and export only one table into this database? If the main database has 10 tables 10 files should be created and the belonging table should export as well.
Here is how:
Public Function ExportTables()
Const Path As String = "C:\Test\"
Dim Workspace As DAO.Workspace
Dim Database As DAO.Database
Dim Table As DAO.TableDef
Dim Tablename As String
Set Workspace = DBEngine(0)
For Each Table In CurrentDb.TableDefs
If Table.Attributes = 0 Then
' This is a local table and not a system table.
Tablename = Table.Name
Set Database = Workspace.CreateDatabase(Path & Tablename, dbLangGeneral)
DoCmd.TransferDatabase acExport, "Microsoft Access", Database.Name, acTable, Tablename, Tablename
Debug.Print "Exported " & Tablename
End If
Next
End Function
Here is some code to create a Database
Private Sub CreateDatabase(nameOfDatabase As String)
On Error Resume Next
Dim accessApp As Access.Application
Set accessApp = New Access.Application
accessApp.DBEngine.CreateDatabase nameOfDatabase & ".accdb", DB_LANG_GENERAL
accessApp.Quit
Set accessApp = Nothing
End Sub
I have Access front end which is powered by SQL Server in backend.
I made a form which requires user input, based on the input it should run a pass through query and should display result in the subform. I have read on internet this cannot be done through sql command and it requires sql coding to be wrapped in VBA coding.
I have made a code this like this:
Private Sub id_AfterUpdate()
Dim MyDb As Database, MyQry As QueryDef
Set MyDb = CurrentDb()
Set MyQry = MyDb.CreateQueryDef("")
MyQry.Connect = "ODBC;DSN=mikecollections;UID=***;PWD=****;DATABASE=mikecollections;"
MyQry.SQL = "select currency.tb_coins.id,documenttype,documentsubtype,documentname" & _
"from currency.tb_coins" & _
"inner join collectibles.tb_documents on tb_coins.id=collectibles.tb_documents.prodid" & _
"where currency.tb_coins.id=[forms]![test_form]![id]"
End Sub
This code should fire after I enter value in the id field in the form, but nothing happens. I do not know how to make this code work. Im new to SQL and VBA, Pls help!
I created a stored procedure in sql server and created a parameter in access to pass into sql server and got it working. Thank you Hansup and iDevlop for all the help.
Private Sub userinput_AfterUpdate()
Dim qrypass As DAO.QueryDef
Dim rst As DAO.Recordset
Set qrypass = CurrentDb.QueryDefs("qu_test")
qrypass.SQL = _
"exec collectibles.sp_coinsvsdocuments " _
& "#userinput=" _
& Forms!test_form!userinput
End Sub
You logically can't refer to an Access object in a passthru query.
So your sql should pass the value of the control, instead of referencing the control itself.
If id is a long:
MyQry.SQL = "select currency.tb_coins.id,documenttype,documentsubtype,documentname" & _
"from currency.tb_coins" & _
"inner join collectibles.tb_documents on tb_coins.id=collectibles.tb_documents.prodid" & _
"where currency.tb_coins.id= " & [forms]![test_form]![id]
Then you need to add the code to assign that querydef to a recordset, in order to read it. Something like:
set rs = myQry.OpenRecordset
If you prefer, you can also name your queryDef. it will then be available like any other query:
Set MyQry = MyDb.CreateQueryDef("someName")
'''specify all properties here...
doCmd.OpenQuery "someName"
Here is a solution for all Microsoft Access
just copy the below code into a Microsoft Access Module and change the parameter
Sub test()
' The "Kim_ZZ_Orderlines" has a string 'arg1' in the sql so we just replace this
' with the new value
RunPassThrough "KIM_ZZ_Orderlines", "Indput value", "10"
End Sub
Sub RunPassThrough(QueryToRun, ArgPrompt, ArgDefault)
' John Henriksen
' 2021-09-23
' Sub procedure to run a Pass-through query with argument
' in the query there must be the string 'Arg1" you want to replace
' e.g. AND APPS.OE_ORDER_LINES_ALL.ATTRIBUTE1 = 'arg1'
arg1 = VBA.InputBox(ArgPrompt, ArgPrompt, ArgDefault)
Dim db As DAO.Database
Dim qry, qryNy As String
Dim qrydefOrginal As DAO.QueryDef
Set db = CurrentDb
Set qdef = db.QueryDefs(QueryToRun)
' Save the original sql
qry = qdef.sql
' Make a new sql, here we search for the string "arg1" and replace with our arg1 value
qryNy = VBA.Replace(qry, "arg1", arg1)
' Set the new sql
qdef.sql = qryNy
DoCmd.OpenQuery QueryToRun
' Set the original sql
qdef.sql = qry
Set qdef = Nothing
Set db = Nothing
End Sub
I've begun developing a reasonably simple access project. The DB and queries were built via the app and I have some code which would run through a table and populate another table based on content. This worked fine until I added an additional field (AsOfDate) to one of the tables and I now get the 3061 error when querying the table. If I remove the new field from the SQL it works fine.
So I've looked at the table object when debugging - can't see the new field and also noticed that another Query I setup doesn't get enumerated either.
Is there something I'm missing here in regard to what I'm doing in the front end app versus what I need to do in the VBA ?
The code is simple (so far) but I'll include it hear for reference.
Public Sub PopulateBillingRecords()
'Quick and dirty attempt to replicate desk billing
Dim wrkSpace As Workspace
Dim dbThisDB As DAO.Database
Dim tblUsers As TableDef
Dim tblPermissions As TableDef
Dim tblTrades As TableDef
Dim tblBilling As TableDef
Dim rsUsers As Recordset
Dim rsPermissions As Recordset
Dim rsTrades As Recordset
Dim rsBilling As DAO.Recordset
Dim qryBilling As DAO.QueryDef
Dim strBillingSQL As String
Dim qryUsers As QueryDef
Dim strUsersSQL As String
Dim rowUser As Variant
Dim datAsOfDate As Date
Dim qryTemp As QueryDef
Dim fldThisField As Field
Dim flsAllFields As Fields
Dim strTempField As String
Set wrkSpace = CreateWorkspace("GVUsers", "admin", "", dbUseJet)
Set dbThisDB = wrkSpace.OpenDatabase("GV User Analysis.accdb")
Set tblUsers = dbThisDB.TableDefs("Users")
Set tblPermissions = dbThisDB.TableDefs("MarketPermissions")
Set tblTrades = dbThisDB.TableDefs("Trades")
Set tblBilling = dbThisDB.TableDefs("Billing")
tblBilling.Fields.Refresh
dbThisDB.TableDefs.Refresh
datAsOfDate = Date
'Assuming existing tables populate by import *code import routine later*
'Clear out any existing billing records 'in future allow data to persist and prompt to either clear down data for current billing period if it exists or append
Set rsBilling = Nothing
strBillingSQL = "SELECT Billing.ID, Billing.CompanyCode, Billing.CompanyName, Billing.TraderName, Billing.TraderID, Billing.ConnectionType," _
& "Billing.IsDisabled, Billing.SetupDate, Billing.TPLogCount, Billing.HasConcession, Billing.IsBillable, Billing.BillingPeriod, Billing.DeskByOrdersTrades," _
& "Billing.DeskByPermissions, Billing.OverallDeskAllocation, Billing.HasGasPermissions, Billing.HasPowerPermissions, Billing.HasCoalPermissions, Billing.TradesCount," _
& "Billing.OrdersCount, Billing.AllocationGas, Billing.AllocationPower, Billing.AllocationCoal, Billing.AllocationMethod,Billing.AsOfDate" _
& " FROM Billing;"
Set rsBilling = dbThisDB.OpenRecordset(strBillingSQL, dbOpenDynaset) '<---- 3061 error is returned here
I'm going nuts trying to work out what's going on and think that starting over isn't the solution!
Thanks in advance
It can be cut down to this:
Dim wrkSpace As Workspace
Dim dbThisDB As DAO.Database
Dim rsBilling As DAO.Recordset
Dim strBillingSQL As String
Set wrkSpace = CreateWorkspace("GVUsers", "admin", "", dbUseJet)
Set dbThisDB = wrkSpace.OpenDatabase("GV User Analysis.accdb")
strBillingSQL = "SELECT Billing.ID, Billing.CompanyCode, Billing.CompanyName, Billing.TraderName, Billing.TraderID, Billing.ConnectionType," _
& "Billing.IsDisabled, Billing.SetupDate, Billing.TPLogCount, Billing.HasConcession, Billing.IsBillable, Billing.BillingPeriod, Billing.DeskByOrdersTrades," _
& "Billing.DeskByPermissions, Billing.OverallDeskAllocation, Billing.HasGasPermissions, Billing.HasPowerPermissions, Billing.HasCoalPermissions, Billing.TradesCount," _
& "Billing.OrdersCount, Billing.AllocationGas, Billing.AllocationPower, Billing.AllocationCoal, Billing.AllocationMethod,Billing.AsOfDate" _
& " FROM Billing;"
Set rsBilling = dbThisDB.OpenRecordset(strBillingSQL, dbOpenDynaset) '<---- 3061 error is returned here
That error indicates, that a field in strBillingSQL is misspelled or does not exist in the table.
I have 60 MS Access files with the same database structure. I want to take data from two tables which are in relation from each database to make one single database with all of the records from those 60 files. Is there any easy way to merge all those MS Access files?
If I understand you correctly, you have identical tables spread across 60 database files, and you are looking at a way of automating their aggregation.
There's a few different ways you can do this. It'll probably depend on your circumstances. I've demonstrated two different approaches.
The first method is straightforward. It simply builds a static query, substituting the database name into each query. If your specifics are simplistic - then this should do the trick.
The second method uses DAO to open each table in each database and write the data to the current database. This method is beneficial if you have one-off exceptions and need to add some intelligence.
Public Sub SimpleCombine()
Dim DBFileList As Collection
Dim DBPath As String
Dim ForeignTableName As String
Dim LocalTableName As String
Dim dbfile As Variant
' Configure
Set DBFileList = New Collection
DBFileList.Add "Test1.accdb"
DBFileList.Add "Test2.accdb"
DBPath = CurrentProject.Path ' (No Trailing Backslash)
ForeignTableName = "Fruit"
LocalTableName = "Fruit"
For Each dbfile In DBFileList
querystr = "INSERT INTO Fruit (FruitName, FruitValue) " & _
"SELECT FruitName, FruitValue " & _
"FROM Fruit IN '" & DBPath & "\" & dbfile & "'"
Debug.Print "Transferring Data From " & dbfile
CurrentDb.Execute querystr
DoEvents
Next
End Sub
Example #2
Public Sub DAOCombine()
Dim DBFileList As Collection
Dim DBPath As String
Dim ForeignTableName As String
Dim LocalTableName As String
Dim db As DAO.Database
Dim rst, drst As DAO.Recordset
Dim fld As DAO.Field
' Configure
Set DBFileList = New Collection
DBFileList.Add "Test1.accdb"
DBFileList.Add "Test2.accdb"
DBPath = CurrentProject.Path ' (No Trailing Backslash)
ForeignTableName = "Fruit"
LocalTableName = "Fruit"
Set drst = CurrentDb.OpenRecordset(LocalTableName)
For Each dbfile In DBFileList
Debug.Print "Transferring Data From " & dbfile
Set db = DBEngine.Workspaces(0).OpenDatabase(DBPath & "\" & dbfile)
Set rst = db.OpenRecordset(ForeignTableName)
Do Until rst.EOF
drst.AddNew
For Each fld In rst.Fields
If (fld.Attributes And dbAutoIncrField) = dbAutoIncrField Then
' We have an autonumber field - lets skip
Else
drst.Fields(fld.Name).Value = fld.Value
End If
Next
drst.Update
rst.MoveNext
Loop
rst.Close
DoEvents
Next
drst.Close
Set rst = Nothing
Set drst = Nothing
End Sub
You'll need to tailor the code to your specific circumstances - but it should do the trick.
If the datastructure is the same you can use a JOIN
Query.
SELECT PORDER_ARV.*
FROM PORDER_ARV
UNION
SELECT PORDER_RAN.*
FROM PORDER_RAN
UNION
SELECT PORDER_HOL.*
FROM PORDER_HOL
UNION SELECT PORDER_HIN.*
FROM PORDER_HIN
ORDER BY PURCHASE_CODE;
When you use Union All ,you will also get duplicates, you can write vba code to auto construct this sql string with your 60 table names. I don't no if the union function works with 60 tables?