Hi,

I'm trying to run a make-table query using VBA such that each time the code is executed, two tables are formed, one with a fixed table name "tbl_CABLE" and the other table having the system date suffixed to its name i.e. tbl_CABLE_13/01/2009 for instance.

I've designed a make-table query in Access that forms "tbl_CABLE" and call this qry_create_table_cable.

The SQL code for qry_create_table_cable is:

SELECT "ABC" AS CLIENT, "XYZ" AS PROJECT, "Cable Schedule" AS DOC_NAME, qry_CABSCHED_cable.[Cable Number], qry_CABSCHED_cable.Size, qry_CABSCHED_cable.Type, qry_CABSCHED_cable.Length, qry_CABSCHED_cable.Remarks INTO tbl_CABLE
FROM qry_CABSCHED_intools_cable
ORDER BY qry_CABSCHED_intools_cable.[Cable Number];


My questions now are:
1) How can I execute the qry_create_table_cable using a VBA module, so that it creates tbl_CABLE each time the module is run without prompting to overwrite the old table?

2) How can I modify qry_create_table_cable in ACCESS/VBA so that the system date could be suffixed to tbl_CABLE in run time to create tbl_CABLE_13/01/2009 etc.

Any insights on these? Thanks in advance

In a module place the following:

DoCmd.SetWarnings False

DoCmd.RunSQL ("SELECT 'ABC' AS CLIENT, 'XYZ' AS PROJECT, 'Cable Schedule' AS DOC_NAME, qry_CABSCHED_cable.[Cable Number], qry_CABSCHED_cable.Size, qry_CABSCHED_cable.Type, qry_CABSCHED_cable.Length, qry_CABSCHED_cable.Remarks INTO tbl_CABLE " & _
"FROM qry_CABSCHED_intools_cable " & _
"ORDER BY qry_CABSCHED_intools_cable.[Cable Number];")

DoCmd.RunSQL ("SELECT 'ABC' AS CLIENT, 'XYZ' AS PROJECT, 'Cable Schedule' AS DOC_NAME, qry_CABSCHED_cable.[Cable Number], qry_CABSCHED_cable.Size, qry_CABSCHED_cable.Type, qry_CABSCHED_cable.Length, qry_CABSCHED_cable.Remarks INTO tbl_CABLE_" & Format(Now(), "DDMMYY") & " " & _
"FROM qry_CABSCHED_intools_cable " & _
"ORDER BY qry_CABSCHED_intools_cable.[Cable Number];")

DoCmd.SetWarnings True

Thanks for that Alan. On somebody else's advice I've used this:

Sub Trial()

DoCmd.SetWarnings False

CurrentDb.Execute "qry_create_table_cable ", dbFailOnError

DoCmd.CopyObject , "tbl_CABLE_" & Format(DATE, "dd/mm/yy"), acTable, "tbl_CABLE"

DoCmd.SetWarnings True

End Sub


It works fine if the query doesn't take any input parameter but when the module is re-run it gives an error saying tbl_CABLE already exists. Why doesn't it over-write the created tables?

How to make it work if the query takes an input paramter from a form because that's what I want to do?

Thanks for any inputs

Using Execute will not permit you to overwrite the table. Use the example I posted as this will overwrite a previous make table.

For parameters you will need to add a where clause to the SQL statement.

Okay, now its working using an OpenQuery method but there is a slight problem when I pass a parameter from a text field in a form to the query - although the module works but it gives a prompt saying "You didn't specify search criteria with a FindRecord Action". and I have to press OK to that.

How can we avoid getting this prompt? The current working module using OpenQuery is

Sub Trial()

DoCmd.SetWarnings False

On Error Resume Next
DoCmd.DeleteObject acTable, "tbl_CABLE"
On Error GoTo 0

DoCmd.OpenQuery "qry_create_table_cable", , acReadOnly
DoCmd.CopyObject , "tbl_CABLE_" & Format(DATE, "dd/mm/yyyy"), acTable, "tbl_CABLE"

DoCmd.SetWarnings True

End Sub

qry_create_table_cable takes an input parameter from a text field in a form and looks like


SELECT "ABC" AS CLIENT, "XYZ" AS PROJECT, "Cable Schedule" AS DOC_NAME, Forms!ABA!tbo_REVISION AS CURR_REV , qry_CABSCHED_cable.[Cable Number], qry_CABSCHED_cable.Size, qry_CABSCHED_cable.Type, qry_CABSCHED_cable.Length, qry_CABSCHED_cable.Remarks INTO tbl_CABLE FROM qry_CABSCHED_cable WHERE ((qry_CABSCHED_cable.Type) Not Like "VENDOR%")ORDER BY qry_CABSCHED_cable.[Cable Number];


How can the Trial() module be modified to suppress the prompt, as the parameter is not a seacrh criteria and SetWarnings is set to False.

thanks loads

Would I have to live with the prompt or is there a way round it?

Thanks for all inputs

In your Query place the following in the criteria of the field you wish to filter on:

=[Forms]![YourFormNameHere]![YourFormTextBox]

I don't want to filter based on the input parameter, instead I just need to display the input parameter in one of the columns of the created table.

The input parameter is highlighted in the SQL code below :


SELECT "ABC" AS CLIENT, "XYZ" AS PROJECT, "Cable Schedule" AS DOC_NAME, Forms!ABA!tbo_REVISION AS CURR_REV, qry_CABSCHED_cable.[Cable Number], qry_CABSCHED_cable.Size, qry_CABSCHED_cable.Type, qry_CABSCHED_cable.Length, qry_CABSCHED_cable.Remarks INTO tbl_CABLE FROM qry_CABSCHED_cable WHERE ((qry_CABSCHED_cable.Type) Not Like "VENDOR%") ORDER BY qry_CABSCHED_cable.[Cable Number];

To be honest with you, that query looks perfectly OK. Unfortunatly with out the Db in front of me I can't help. Hopefully someone else will step in and help.

Thanks anyways for yr time...........much appreciated.

I want to now create the tables in another database titled "IGB" located in:

"D:\Project\INST\db\bdb"

How can I modify the SQL code below or the VBA module so that both tables are created in the other database and not in the current database.

SELECT "ABC" AS CLIENT, "XYZ" AS PROJECT, "Cable Schedule" AS DOC_NAME, Forms!ABA!tbo_REVISION AS CURR_REV, qry_CABSCHED_cable.[Cable Number], qry_CABSCHED_cable.Size, qry_CABSCHED_cable.Type, qry_CABSCHED_cable.Length, qry_CABSCHED_cable.Remarks INTO tbl_CABLE FROM qry_CABSCHED_cable WHERE ((qry_CABSCHED_cable.Type) Not Like "VENDOR%") ORDER BY qry_CABSCHED_cable.[Cable Number];


Sub Trial()

DoCmd.SetWarnings False

On Error Resume Next
DoCmd.DeleteObject acTable, "tbl_CABLE"
On Error GoTo 0

DoCmd.OpenQuery "qry_create_table_cable", , acReadOnly
DoCmd.CopyObject , "tbl_CABLE_" & Format(DATE, "dd/mm/yyyy"), acTable, "tbl_CABLE"

DoCmd.SetWarnings True

End Sub


Thanks again

Check out this link:

http://support.microsoft.com/kb/108147

The code will run in VBA

It gives an error on Print saying it doesn't apply to a suitable object.

Any other ways of copying tables from one database to another?

Change the following code from:

Print CopyStruct(dbsource, dbdest, "titles", "ctitles", True)
Print CopyData(dbsource, dbdest, "titles", "ctitles")

To:

CopyStruct dbsource, dbdest, "titles", "ctitles", True
CopyData dbsource, dbdest, "titles", "ctitles"

Hi Msalem

I have converted the code from VB3 to Access VBA

'Purpose: To copy a table from one database to another.
' Notes: Operates by firstly creating the table in the other database, then
' copies the data across.

'Originally written by Microsoft in VB3.
'Code modified by Allan57 to work in 'MS Access 97 VBA'
'16/01/2009

Dim dbsSource As Database
Dim dbsDestination As Database

Dim strErrorStatement As String

Option Compare Database
Option Explicit

Public Function CreateNewTable(DatabaseSource As Database, DatabaseDestination As Database, TableToCopyFrom As String, TableCreateName As String, CreateFieldIndexs As Boolean) As Boolean

Dim tblCreateNewTable As New TableDef
Dim fldCreateFields As Field
Dim indCreateIndexes As Index
Dim intTableDefCounter As Integer

On Error GoTo CreateNewTableError

NameSearch:

'Search destination Db to see if the create table name already exists:
For intTableDefCounter = 0 To DatabaseDestination.TableDefs.Count - 1

If UCase(DatabaseDestination.TableDefs(intTableDefCou nter).Name) = UCase(TableCreateName) Then

If MsgBox(TableCreateName & " already exists, delete it?", vbYesNo) = vbYes Then

DatabaseDestination.TableDefs.Delete TableCreateName

Else

TableCreateName = InputBox("Enter New Table Name:", "User input required")

If TableCreateName = "" Then

GoTo CreateNewTableError

Else

GoTo NameSearch

End If

End If

Exit For

End If
Next

'Strip off owner if necessary:
If InStr(TableCreateName, ".") <> 0 Then

TableCreateName = Mid(TableCreateName, InStr(TableCreateName, ".") + 1, Len(TableCreateName))

End If

tblCreateNewTable.Name = TableCreateName

'Create the fields:
For intTableDefCounter = 0 To DatabaseSource.TableDefs(TableToCopyFrom).Fields.C ount - 1

Set fldCreateFields = New Field

fldCreateFields.Name = DatabaseSource.TableDefs(TableToCopyFrom).Fields(i ntTableDefCounter).Name
fldCreateFields.Type = DatabaseSource.TableDefs(TableToCopyFrom).Fields(i ntTableDefCounter).Type
fldCreateFields.Size = DatabaseSource.TableDefs(TableToCopyFrom).Fields(i ntTableDefCounter).Size
fldCreateFields.Attributes = DatabaseSource.TableDefs(TableToCopyFrom).Fields(i ntTableDefCounter).Attributes

tblCreateNewTable.Fields.Append fldCreateFields

Next

'Create the indexes:
If CreateFieldIndexs = True Then

For intTableDefCounter = 0 To DatabaseSource.TableDefs(TableToCopyFrom).Indexes. Count - 1

Set indCreateIndexes = New Index

indCreateIndexes.Name = DatabaseSource.TableDefs(TableToCopyFrom).Indexes( intTableDefCounter).Name
indCreateIndexes.Fields = DatabaseSource.TableDefs(TableToCopyFrom).Indexes( intTableDefCounter).Fields
indCreateIndexes.Unique = DatabaseSource.TableDefs(TableToCopyFrom).Indexes( intTableDefCounter).Unique
indCreateIndexes.Primary = DatabaseSource.TableDefs(TableToCopyFrom).Indexes( intTableDefCounter).Primary

tblCreateNewTable.Indexes.Append indCreateIndexes

Next

End If

'Append the new table:
DatabaseDestination.TableDefs.Append tblCreateNewTable

CreateNewTable = True

Exit Function

CreateNewTableError:

If Err.Number = 0 Then

strErrorStatement = "Operation Aborted by User"

Else

strErrorStatement = Err.Number & " - " & Err.Description

End If

CreateNewTable = False

End Function

Public Function CopyData(DatabaseSource As Database, DatabaseDestination As Database, TableToCopyFrom As String, TableCreateName As String) As Boolean

Dim rstDatabaseSource As Recordset
Dim rstDatabaseDestination As Recordset
Dim intFieldCounter As Integer

On Error GoTo CopyDataError

Set rstDatabaseSource = dbsSource.OpenRecordset(TableToCopyFrom)
Set rstDatabaseDestination = dbsDestination.OpenRecordset(TableCreateName)

While rstDatabaseSource.EOF = False

rstDatabaseDestination.AddNew

For intFieldCounter = 0 To rstDatabaseSource.Fields.Count - 1

rstDatabaseDestination(intFieldCounter) = rstDatabaseSource(intFieldCounter)

Next

rstDatabaseDestination.Update

rstDatabaseSource.MoveNext

Wend

CopyData = True

Exit Function

CopyDataError:

strErrorStatement = Err.Number & " - " & Err.Description

CopyData = False

End Function

Private Sub Form_Load()

Dim strSourceDatabase As String
Dim strDesinationDatabase As String
Dim strSourceTableNameToCopyFrom As String
Dim strDestinationTableNameToCreate As String

Dim fCreateTableIndexesAsWell As Boolean

On Error Resume Next


strSourceDatabase = "c:\db3.mdb"
strDesinationDatabase = "c:\db2.mdb"
strSourceTableNameToCopyFrom = "Table1"
strDestinationTableNameToCreate = "cTable1"
fCreateTableIndexesAsWell = True

Set dbsSource = OpenDatabase(strSourceDatabase, False, True)
Set dbsDestination = OpenDatabase(strDesinationDatabase, False, False)

If CreateNewTable(dbsSource, dbsDestination, strSourceTableNameToCopyFrom, strDestinationTableNameToCreate, fCreateTableIndexesAsWell) = False Then

MsgBox "Failure Creating Table, Operation Aborted" & vbCrLf & vbCrLf & strErrorStatement

GoTo ExitAndCloseObjectReferences

Exit Sub

End If

If CopyData(dbsSource, dbsDestination, strSourceTableNameToCopyFrom, strDestinationTableNameToCreate) = False Then

MsgBox "Failure Copying Data to Table, Operation Aborted" & vbCrLf & vbCrLf & strErrorStatement

GoTo ExitAndCloseObjectReferences

End If

MsgBox "Success Creating/Copying Table"

ExitAndCloseObjectReferences:

dbsSource.Close
dbsDestination.Close
Set dbsSource = Nothing
Set dbsDestination = Nothing

End Sub