I was looking for the exact same thing as the person that posted the following question:
1 MS Access Query to Multiple Excel Files Based on Field Value
This answer:
Dim Db As DAO.Database, qdef AS DAO.QueryDef, rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT DISTINCT [CustomerName] FROM [QueryName]")
Do While Not rst.EOF
Set qdef = db.QueryDefs("[MyTempQuery]")
qdef.SQL = "SELECT * FROM [QueryName] WHERE Customer = '" & rst!CustomerName & "'"
Set qdef = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "MyTempQuery", _
"C:\Path\To\Excel\Files\" & rst!CustomerName & ".xlsx", True
rst.MoveNext
Loop
rst.Close
Set rst = Nothing: Set db = Nothing
...provided by #Parfait worked wonders, but since this access file is going to be used by several other people i now need the access to export the files in a sub folder of the same folder as the Access file instead of specifying an exact folder path in the code. Can anyone help me with that please?
Thank you all in advance!
I am not sure if I got your question right. Do you mean:
a) The Macro has multiple users and the regarding DB is located on a shared drive:
--> if that is the case: just change "C:\Path\To\Excel\Files" to whatever is the path to the shared drive.
b) if there is no shared drive and the the macro happens to be used locally: use "C:\Temp" as path. This folder exists on every Windows machine. With that you can be sure the path is found and the files can be saved.
I found out the solution to this. Basically i declared a variable as a string, and then used that variable to store the location of the access file. Then i created a folder inside that location and used it as the export target.
Dim Db As DAO.Database, qdef AS DAO.QueryDef, rst As DAO.Recordset, expPath As String
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT DISTINCT [CustomerName] FROM [QueryName]")
expPath = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))
MkDir expPath & "EXPORT"
Do While Not rst.EOF
Set qdef = db.QueryDefs("[MyTempQuery]")
qdef.SQL = "SELECT * FROM [QueryName] WHERE Customer = '" & rst!CustomerName & "'"
Set qdef = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "MyTempQuery", _
expPath & "EXPORT\" & rst!CustomerName & ".xlsx", True
rst.MoveNext
Loop
rst.Close
Set rst = Nothing: Set db = Nothing
Related
I have an Access table that I need to convert to SQL Server, but it has an attachment field. I am trying to export all the attachments to a specified folder and have each attachment files grouped by the primary key folder.
Function ExtractAttachment()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim fld As DAO.Field
Dim savePath As String
savePath = "\\MyFolder\" 'Folder path to save files
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblEmpInfo") 'tblEmpInfo is table name
Set fld = rst("EmpPhoto") 'EmpPhoto is Field name to table with attachment data type.
Do While Not rst.EOF 'Loop through all records of table.
Set rsA = fld.Value
On Error Resume Next 'Omit errors if file already exist
Do While Not rsA.EOF 'Loop through all attachment of single record
rsA.Fields("FileData").SaveToFile savePath & rst.Fields(0) & "\" 'Save file to disk
rsA.MoveNext
Loop
rst.MoveNext
Loop
rst.Close
dbs.Close
Set fld = Nothing
Set rst = Nothing
Set dbs = Nothing
End Function
If I remove & rst.Fields(0) & "\" it creates all the files, but under the same folder and have no way to differentiate them.
How can I export the attachments by folder using the autonumber of the field (Primary Key)?
Need to make sure folder exists and if not, create it.
If Dir(savePath & rst.Fields(0)) = "" Then MkDir savePath & rst.Fields(0)
If you want to include record ID in exported file's name, specify in the destination path. Can still save to subfolders or just all into one folder.
rsA.Fields("FileData").SaveToFile savePath & rst.Fields(0) & "\" & rst.Fields(0) & rsA.Fields("FileName")
i have a bunch of large Oracle tables that need to be imported into MS Access. They each go into its own database, because they're huge. Right now i'm linking them into the database that runs the procedure and then exporting into external databases using INSERT INTO.
Horribly slow.
TransferDatabase is much faster but i don't see how i can use that for external databases.
Is there a way? Or is there a way to do this quickly using some other method? This is part of an automation, so it can't be any manual solutions, has to be VBA.
In case someone is wondering why I'm doing this - these are files that go to requestors as results of a report.
Here's one way you could do it.
Create an Access database called importfile_template.accdb that contains the following:
– a table named import_config with three fields, all ShortText(255)
odbc_connection_string
source_tablename
destination_tablename
– a module containing
Option Compare Database
Option Explicit
Public Function do_import()
Dim cdb As DAO.Database
Set cdb = CurrentDb
Dim tbd As DAO.TableDef
On Error Resume Next
Set tbd = cdb.TableDefs("import_config")
If Err.Number = 0 Then
Dim rst As DAO.Recordset
Set rst = cdb.OpenRecordset("import_config", dbOpenTable)
DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;" & rst!odbc_connection_string, _
acTable, rst!source_tablename, rst!destination_tablename
rst.Close
Set rst = Nothing
DoCmd.DeleteObject acTable, "import_config"
Set cdb = Nothing
Application.Quit
End If
End Function
– and a macro named AutoExec that simply does
RunCode (do_import())
Then in your main database you can use VBA code like this:
Sub perform_import()
Dim cdb As DAO.Database
Set cdb = CurrentDb
Dim this_filespec As String
this_filespec = CurrentProject.FullName
Dim current_folder As String
current_folder = Left(this_filespec, InStrRev(this_filespec, "\"))
Dim import_filespec As String
import_filespec = current_folder & "zzz_test.accdb" ' my test setting
' VBA project reference required:
' Windows Script Host Object Model
Dim fso As New FileSystemObject
fso.CopyFile current_folder & "importfile_template.accdb", import_filespec
Set fso = Nothing
Dim qdf As DAO.QueryDef
Set qdf = cdb.CreateQueryDef("")
qdf.SQL = _
"UPDATE [" & import_filespec & "].import_config SET " & _
"odbc_connection_string = prm_odbc, " & _
"source_tablename = prm_source, " & _
"destination_tablename = prm_destination"
qdf!prm_odbc = "DSN=mssqlLocal" '
qdf!prm_source = "ThousandRows" ' my test settings
qdf!prm_destination = "thousand_rows" '
qdf.Execute dbFailOnError
qdf.Close
Set qdf = Nothing
Set cdb = Nothing
Dim wsh As New WshShell
wsh.Run import_filespec
Set wsh = Nothing
End Sub
Note: When opening importfile_template.accdb from within Access be sure to hold down the Shift key to prevent the AutoExec macro from running.
I have some code that I copied and modified from Export Query in VBA loop to select data based on String Value
The code works although the problem is that when it runs it creates a query in the database which is then deleted at the end. If the code breaks half way through, this query is still in the database. So when the code is run again it gives an error message saying it can't create the query as it already exists.
The query that is created within the database is named "Select * from SalesData"
The objective is that I have a query called "SalesData" which includes sales information for a number of countries. I want to export all the data for each country into an Excel file in a loop without creating any additional Access objects. Is it possible to just filter the existing query within the VBA without creating the temporary object?
Can anyone suggest any modifications to the below code to achieve this?
Sub TEST()
Dim db As DAO.Database
Set db = CurrentDb()
Dim rs1 As DAO.Recordset
Set rs1 = db.OpenRecordset("Select Distinct Country From SalesData")
Dim v As String
Dim strQry As String
Dim qdfTemp As DAO.QueryDef
Dim strQDF As String
strQDF = "select * from SalesData"
Do While Not rs1.EOF
v = rs1.Fields(0).Value
strQry = "SELECT * FROM SalesData WHERE Country = '" & v & "'"
Set qdfTemp = CurrentDb.CreateQueryDef(strQDF, strQry)
qdfTemp.Close
Set qdfTemp = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
strQDF, "C:\Users\me\Desktop\VBA_TEST\" & v & ".xlsx", True
CurrentDb.QueryDefs.Delete strQDF
rs1.MoveNext
Loop
rs1.Close
End Sub
As far as I'm aware, it would not be possible to use the TransferSpreadsheet method to extract a parameterised version of your SalesData query without either modifying the SQL of the SalesData query itself or using an additional query with selection criteria applied to the data returned by SalesData.
However, you needn't delete & recreate such query with every iteration of the loop - instead, simply modify the SQL property of the query, e.g.:
Sub test()
Dim qry As String: qry = "salesdata_temp"
Dim sql As String: sql = "select * from salesdata where country = '{0}'"
Dim out As String: out = "C:\Users\me\Desktop\VBA_TEST\"
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
On Error Resume Next
DoCmd.DeleteObject acQuery, qry
On Error GoTo error_handler
Set dbs = CurrentDb
Set qdf = dbs.CreateQueryDef(qry, sql)
With dbs.OpenRecordset("select distinct country from salesdata")
If Not .EOF Then
.MoveFirst
Do Until .EOF
qdf.sql = Replace(sql, "{0}", !country)
DoCmd.TransferSpreadsheet acExport, , qry, out & !country & ".xlsx", True
.MoveNext
Loop
End If
.Close
End With
exit_sub:
On Error Resume Next
DoCmd.DeleteObject acQuery, qry
Exit Sub
error_handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation + vbOKOnly, "Error"
Resume exit_sub
End Sub
Thanks to the input here, it seems that the only way to do it is to manipulate an existing query in the database or to create a query in the VBA script and then delete it at the end.
See below for an example of the first approach, the code uses a query already in the database called "blankquery".
Sub TEST()
Dim db As DAO.Database
Set db = CurrentDb()
Dim rs1 As DAO.Recordset
Set rs1 = db.OpenRecordset("Select Distinct Country From SalesData")
Dim qdfTemp As DAO.QueryDef
Dim v As String
Dim strQry As String
Dim strQDF As String
strQDF = "blankquery"
Do While Not rs1.EOF
v = rs1.Fields(0).Value
strQry = "SELECT * FROM SalesData WHERE Country = '" & v & "'"
db.QueryDefs(strQDF).sql = strQry
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
strQDF, "C:\Users\me\Desktop\VBA_TEST\" & v & ".xlsx", True
rs1.MoveNext
Loop
rs1.Close
End Sub
I Am trying to run this SQL statement and then export the result to an excel spread sheet. I've looked through the the internet and found this, which seemed to work for other users.
It runs but asks me to "Enter Parameter Value" linking to "selecteduser" on line 4 of the code, the message box shows up at the point where the code starts here: DoCmd.TransferSpreadsheet. If I click ok the excel sheet is created but with nothing in except the titles from the selected columns from the tables in the database. If i put valid data into the text box and press ok, then the excel spreadsheet is created with the correct data showing.
I know that the selected data in the ComboBox is been stored, because if I do a Message box it shows the selected data from the combobox.
Any ideas anyone? It's obvious the data isn't been passed through somewhere, but I can't see where.
Private Sub Command12_Click()
Dim strSQL As String
Dim strQry As String
Dim selecteduser As String
Dim db As DAO.Database
Dim Qdf As QueryDef
selecteduser = Me.Combo6.Column(0)
strSQL = "SELECT tblPra.praNo, tblFolder.folder, tblFolder.fullTitle FROM tblPra INNER JOIN (tblFolder INNER JOIN tblRelationship ON tblFolder.folderID = tblRelationship.folderID) ON tblPra.praID = tblRelationship.praID WHERE (((tblPra.praNo)=selecteduser));"
strQry = "tempuser"
Set db = CurrentDb
Set Qdf = db.CreateQueryDef(strQry, strSQL)
On Error Resume Next
DoCmd.DeleteObject acQuery, "strQry"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
strQry, "C:\Users\prc93\Desktop\test.xls", True
DoCmd.DeleteObject acQuery, strQry
End Sub
the selecteduser in your query needs to be outside of the quotes. as it is a string it needs to be in single quotes like 'selecteduser'. Now if you msgbox your query and you should see that the selecteduser equals your column (0). are you sure that selecteduser needs to be a string and not a number e.g. long?
Private Sub Command12_Click()
Dim strSQL As String
Dim strQry As String
Dim selecteduser As String
Dim db As DAO.Database
Dim Qdf As QueryDef
selecteduser = Me.Combo6.Column(0)
strSQL = "SELECT tblPra.praNo, tblFolder.folder, tblFolder.fullTitle FROM " &_
"tblPra INNER JOIN (tblFolder INNER JOIN tblRelationship ON " &_
"tblFolder.folderID = tblRelationship.folderID) ON " &_
"tblPra.praID = tblRelationship.praID " &_
"WHERE (((tblPra.praNo)='" & selecteduser & "'));"
strQry = "tempuser"
Set db = CurrentDb
Set Qdf = db.CreateQueryDef(strQry, strSQL)
On Error Resume Next
DoCmd.DeleteObject acQuery, "strQry"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
strQry, "C:\Users\prc93\Desktop\test.xls", True
DoCmd.DeleteObject acQuery, strQry
End Sub
I have two Excel files, a master file and a regular file. Both files have a sheet with the same data structure (same fields, but not formatted as tables).
What I'm trying to do is use VBA to create data connections to both files, and then use SQL to update the master file with any changes in the regular file. The reason for using SQL and a data connection is to avoid opening the regular file and hopefully faster performance overall.
I'm having difficulty with the UPDATE statement, and I'm not sure I'm even going about this in the best manner. My code thus far:
Sub Main()
Dim cnn1 As New ADODB.Connection
Dim cnn2 As New ADODB.Connection
Dim rst1 As New ADODB.Recordset
Dim rst2 As New ADODB.Recordset
Dim arrData() As Variant
Dim fPath As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Files", "*.xls*"
.InitialFileName = ThisWorkbook.Path & "/Meeting Cuts"
.Title = "Please select the file that contains the values you'd like to import."
.Show
fPath = .SelectedItems(1)
End With
DoEvents
cnn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & CStr(fPath) & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"
cnn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & CStr(ThisWorkbook.FullName) & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"
rst1.Open "SELECT * FROM [Sheet1$];", cnn1, adOpenStatic, adLockReadOnly
rst2.Open "UPDATE [Account Data$]" & _
"SET Account_ID = (SELECT Account_ID FROM " & rst1.GetRows & " WHERE Empl_Name = 'Smith,John')" & _
"WHERE Empl_Name = 'Smith,John'", cnn2, adOpenStatic, adLockReadOnly
Set rst1 = Nothing
Set rst2 = Nothing
Set cnn1 = Nothing
Set cnn2 = Nothing
End Sub
When I execute the code, I get a Run-time error '13': Type Mismatch on the rst2.Open line. When I go into debug mode and try to execute that line again, I get a different error: Run-time error '3021': Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record.
I know that I'm using GetRows improperly. Is there a way to reference the sheet (from the regular file) somehow in the UPDATE statement? If so, how would I do it?