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
Related
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.
I'm working with a database in Access 2007, one front end and a few backends.
I like to convert all my linked tables to local for offline work so that i don't accidentally spoil the data.
I delete all the relations and tables and then run a saved import.
I'd like to recreate linked tables after I'm done with modifications. Problem is, Access won't save the import of linked tables. Is there a way to simply link all the tables from backend to frontend with VBA
I found this on the net that works, though slow
Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean
On Error GoTo CreateAttachedError
Dim tdf As TableDef
Dim strConnect As String
Dim fRetval As Boolean
Dim myDB As Database
DoCmd.SetWarnings False
Set myDB = CurrentDb
Set tdf = myDB.CreateTableDef(strTable)
With tdf
.Connect = ";DATABASE=" & strPath
.SourceTableName = strBaseTable
End With
myDB.TableDefs.Append tdf
fRetval = True
DoCmd.SetWarnings True
CreateAttachedExit:
createAttached = fRetval
Exit Function
CreateAttachedError:
If Err = 3110 Then
Resume CreateAttachedExit
Else
If Err = 3011 Then
Resume Next
End If
End If
End Function
https://www.microsoftaccessexpert.com/Microsoft-Access-Code-LinkTable.aspx
I am trying to output the name of all linked tables, including their fields which are Date/Time, and that fields values.
The following code can output the first table, field name and their first value, not all values, although when it gets to the next linked table, I get this error
Run-time Error '3622'
You must use the dbSeeChanges option with OpenRecordSet when accessing a SQL Server table that has an IDENTITY column.
Here is my code
Private Sub btnGetFields_Click()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim f As Field
Dim rst As DAO.Recordset
Dim numField As Integer
Set db = CurrentDb
For Each tdf In db.TableDefs
If Left$(tdf.Connect, 9) = "ODBC;DSN=" Then
Set rst = CurrentDb.OpenRecordset(tdf.Name)
numField = rst.Fields.Count
Debug.Print "Table: " & tdf.Name
For index = 0 To numField - 1
If rst.Fields(index).Type = dbDate Then
Debug.Print "Field: " & rst.Fields(index).Name; " Value : "; rst.Fields(index).Value
End If
Next
End If
Next
Set tdf = Nothing
Set db = Nothing
End Sub
I read something that if I'm using sql tables I should use ADO?
Any ideas?
You can continue to use your existing DAO code, just change
Set rst = CurrentDb.OpenRecordset(tdf.Name)
to
Set rst = CurrentDb.OpenRecordset(tdf.Name, dbOpenSnapshot)
That opens a static read-only Recordset, so dbSeeChanges is not required.
I have actually this little function working as supposed:
Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean
On Error GoTo CreateAttachedError
Dim tdf As TableDef
Dim strConnect As String
Dim fRetval As Boolean
Dim myDB As Database
DoCmd.SetWarnings False
Set myDB = CurrentDb
Set tdf = myDB.CreateTableDef(strTable)
With tdf
.Connect = ";DATABASE=" & strPath
.SourceTableName = strBaseTable
End With
myDB.TableDefs.Append tdf
myDB.TableDefs.Refresh
fRetval = True
DoCmd.SetWarnings True
CreateAttachedExit:
createAttached = fRetval
Exit Function
CreateAttachedError:
If Err = 3110 Then
Resume CreateAttachedExit
Else
If Err = 3011 Then
Resume Next
Else
If Err = 3012 Then
Set tdf = myDB.TableDefs(strTable)
tdf.Connect = ";DATABASE=" & strPath
tdf.RefreshLink
fRetval = True
GoTo CreateAttachedExit
End If
End If
End If
End Function
This code works fine, I can call the function as many times as I want to add links to tables from another database. However, I have about 30 tables to import from the same database and this script restarts from scratch everytime I call it. Because the database is located on another server, it takes about 1 min to link the 30 tables.
Is there anything I could do with that function to make it work faster when I need to link multiple tables from the same database? I would like it to work with multiple strTable and strBaseTable in parameters instead of one (maybe arrays?), but I don't know how to do this.
Thank you.
You can loop through the tabledefs collection in the external database or use a table of tables that lists all the tables to be connected and the external database.
Dim db As Database
Dim ThisDb As Database
Set ThisDb = CurrentDB
sDb = "z:\docs\test.accdb"
Set db = OpenDatabase(sDb)
For Each tdf In db.TableDefs
''Connect
If Left(tdf.Name, 4) <> "MSys" Then
If IsNull(DlookUp("Name","MsysObjects","Type In (1,4,5,6) And Name='" _
& tdf.Name & "'")) Then
DoCmd.TransferDatabase acLink, "Microsoft Access", _
sDb, acTable, tdf.Name, tdf.Name
Else
If ThisDb.TableDefs(tdf.Name).connect <> vbNullString Then
ThisDb.TableDefs(tdf.Name).connect = ";DATABASE=" & sDb
ThisDb.TableDefs(tdf.Name).RefreshLink
End If
End If
End If
Next
A table of tables would work in a similar fashion in that you can select the database (select distinct) from the table and loop through that recordset attaching the tables in a further selection (select table where database ...)
What you could also do is set up the database connect in a different sub as well as the database disconnect (which I might be missing here?).
So then the code that calls this script normally (I assume you have a loop) will look like this:
call function/sub that opens the connection to DATABASE= strPath
your loop that calls Function createAttached
call function/sub that closes the connection to DATABASE= strPath
That way you avoid the repetitive (usually time consuming) connection to the external database
I found the following function while browsing the Web that allows me to dynamically link a table to my Access database at the execution:
Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean
'************************************************************************************
'* Create an attached table in the current database from a table in a different MDB file.
'* In: *
'* strTable - name of linked table to create *
'* strPath - path and name of MDB file containing the table *
'* strBaseTable - name of table in strPath MDB *
'* Out: *
'* Return value: True/False, indicating success *
'* Modifies: *
'* Nothing, but adds a new table. *
'************************************************************************************
On Error GoTo CreateAttachedError
Dim tdf As TableDef
Dim strConnect As String
Dim fRetval As Boolean
Dim myDB As Database
DoCmd.SetWarnings False
Set myDB = CurrentDb
Set tdf = myDB.CreateTableDef(strTable)
With tdf
.Connect = ";DATABASE=" & strPath
.SourceTableName = strBaseTable
End With
myDB.TableDefs.Append tdf
fRetval = True
DoCmd.SetWarnings True
CreateAttachedExit:
createAttached = fRetval
Exit Function
CreateAttachedError:
If Err = 3110 Then
Resume CreateAttachedExit
Else
If Err = 3011 Then
Resume Next
End If
End If
End Function
This script works, however, if the table is already linked, it just does nothing (but an error event is still triggerered). I would like the same script to delete the linked table if it exists, or at least refresh that link so that the path is the right one. I have no idea of how to do this, it's probably quite simple but I don't know where to start.
Thank you.
Here's what I use. It also tests for if the table is a linked table before trying to refresh the link.
This code assumes that the db you're linking to is in the same folder as the db you're linking from. If not, remove the "Application.CurrentProject.Path" and add the appropiate path.
Public Sub RelinkTables()
Dim dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Set dbs = CurrentDb
Set Tdfs = dbs.TableDefs
For Each Tdf In Tdfs
If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
Tdf.Connect = ";DATABASE=" & Application.CurrentProject.Path & "\filename.accdb" 'Set the new source
Tdf.RefreshLink 'Refresh the link
End If
Next 'Goto next table
End Sub