Copy a table and rename it

[Guest]

I splitted my database, and I placed the backend on the network.
I would like to know how can I copy a table called,"EXAMPLE", from my database
called, "DATA.mdb", and placed the table into an nonexisting database that
will be namedaccording to the current date and then it will be added to
I:\DATAE\... For example, for today, I would like, "EXAMPLE", to be copied
to the non-existing database,but it will automatically be named,
"DE20060926". "DE" will remain the same;however, the date will be change
daily. I want the user to save the database once daily. So, I would need some
error trapping message stating that, "the database has been saved for today".
All this will be done when the user clicks on a button. Can you help me w/
some VBA to get this accomplished?

 

[pietlinden]

Use DIR to see if the file exists. If the file exists, pop up the
message, otherwise just save the file.

 

[Guest]

Can you help me w/ some VBA on how to copy an object(table) with its data
into a nonexisting database and also how to use the Dir to see if the file
exists?

 

[Douglas J. Steele]

You have to create the database first.

Dim dbNew As DAO.Database
DIm strDatabase As String

strDatabase = "C:\Folder\File.MDB"

' Check whether the database already exists, and create it if it doesn't
If Len(Dir(strDatabase)) = 0 Then
Set dbNew = DBEngine.Workspaces(0).CreateDatabase( _
strDatabase, dbLangGeneral)
End If

' Copy Table MyTable, and name it MyTableBackup in other database
DoCmd.TransferDatabase acExport, "Microsoft Access", _
strDatabase, acTable, "MyTable", "MyTableBackup"

 

[Guest]

Thanks for your quick respond. When I added the code below, it linked the
the my "Records" table to my "EXAMPLE" table. I don't want it to link my
"Records" table w/ my "EXAMPLE" table. As I mention earlier, I splitted my
database, and I added the backend to the Network. I think that when I use
the transfer database command it made a link between the two tables. Here is
my code below:

Dim ws As Workspace
Dim dbNew As DAO.Database
Dim NewFolder As String
Dim Stoday As Date
Dim NewFileName As String
Dim edit As Integer
Dim mydate As Date
mydate = #8/9/2006#
Stoday = #8/9/2006#
mydate = DateAdd("d", 0, Date)


edit = MsgBox("Are you sure you want to save the database for " & mydate,
vbCritical + vbYesNo, "Save Database")
If edit = 6 Then
Me.AllowEdits = True

'Get default Workspace
'Set ws = DBEngine.Workspaces(0)
Stoday = DateAdd("d", 0, Date)
NewFileName = "de" & CStr(Year(Stoday)) & CStr(Month(Stoday)) &
CStr(Day(Stoday)) & ".mdb"

NewFolder = "I:\Susdata\BRCC\BRCC\DATA ENTRY\ " & NewFileName
'Make sure there isn't already a file with the name of the new database
If Len(Dir(NewFileName)) = 0 Then
Set dbNew = DBEngine.Workspaces(0).CreateDatabase(NewFolder, dbLangGeneral)
End If

DoCmd.TransferDatabase acExport, "Microsoft Access", NewFolder, acTable,
"EXAMPLE", "Records"
MsgBox "Database has been saved", vbInformation, "Data Transfer"
Else: MsgBox "Your request has been denied. You have chosen not to save the
database", , "Request Canceled"
End If

End Sub

 

[Douglas J. Steele]

Since your tables are actually in the back-end, not the front-end, you need
to ensure you're copying the table from the back-end, not the front-end.

That means you need to instantiate an instance of Access, set its current
database to the back-end database and use that instance of Access, not the
one associated with the front-end:

Dim appAccess As Access.Application

Set appAccess = New Access.Application
appAccess.OpenCurrentDatabase "FullPathToBackEndDatabase"
appAccess.DoCmd.TransferDatabase acExport, _
"Microsoft Access", NewFolder, acTable, "EXAMPLE", "Records"

BTW, you've got an error in what you posted.

NewFolder = "I:\Susdata\BRCC\BRCC\DATA ENTRY\ " & NewFileName
'Make sure there isn't already a file with the name of the new database
If Len(Dir(NewFileName)) = 0 Then
Set dbNew = DBEngine.Workspaces(0).CreateDatabase(NewFolder, dbLangGeneral)
End If

needs to be

NewFolder = "I:\Susdata\BRCC\BRCC\DATA ENTRY\ " & NewFileName
'Make sure there isn't already a file with the name of the new database
If Len(Dir(NewFolder)) = 0 Then ' <=== Error here
Set dbNew = DBEngine.Workspaces(0).CreateDatabase(NewFolder, dbLangGeneral)
End If

 

[Guest]

Thank you for your reply. However, now, I am getting a runtime error 3045.
I am listing my new code below.

Public Sub Command23_Click()
'Save the database daily
Dim ws As Workspace
Dim appAccess As Access.Application
Dim dbNew As DAO.Database
Dim NewFolder As String
Dim Stoday As Date
Dim NewFileName As String
Dim edit As Integer
Dim mydate As Date
mydate = #8/9/2006#
Stoday = #8/9/2006#
mydate = DateAdd("d", 0, Date)


edit = MsgBox("Are you sure you want to save the database for " & mydate,
vbCritical + vbYesNo, "Save Database")
If edit = 6 Then
Me.AllowEdits = True

'Get default Workspace
Stoday = DateAdd("d", 0, Date)
NewFileName = "de" & CStr(Year(Stoday)) & CStr(Month(Stoday)) &
CStr(Day(Stoday)) & ".mdb

'Path and file name for new mdb file
NewFolder = "I:\Susdata\BRCC\BRCC\DATA ENTRY\ " & NewFileName
'Make sure there isn't already a file with the name of the new database
If Len(Dir(NewFolder)) = 0 Then
Set dbNew = DBEngine.Workspaces(0).CreateDatabase(NewFolder, dbLangGeneral)
End If
Set appAccess = New Access.Application
appAccess.OpenCurrentDatabase "I:\Susdata\BRCC\BRCC\DATA
ENTRY\DataEntrymAIN2_be.mdb"
appAccess.DoCmd.TransferDatabase acExport, "Microsoft Access", NewFolder,
acTable, "EXAMPLE", "Records"
MsgBox "Database has been saved", vbInformation, "Data Transfer"
dbNew.Close
Set dbNew = Nothing
Else: MsgBox "Your request has been denied. You have chosen not to save the
database", , "Request Canceled"
End If
End Sub

 

[Douglas J. Steele]

Error 3045 is "file already in use."

After you create the database, you don't need it to be instantiated.

Try changing:

If Len(Dir(NewFolder)) = 0 Then
Set dbNew = DBEngine.Workspaces(0).CreateDatabase(NewFolder,
dbLangGeneral)
End If

to either

If Len(Dir(NewFolder)) = 0 Then
Set dbNew = DBEngine.Workspaces(0).CreateDatabase(NewFolder,
dbLangGeneral)
Set dbNew = Nothing
End If

or

If Len(Dir(NewFolder)) = 0 Then
Call DBEngine.Workspaces(0).CreateDatabase(NewFolder, dbLangGeneral)
End If

It's also possible that you may need to ensure exclusive access to the
database, in which case you could try replacing:

appAccess.OpenCurrentDatabase "I:\Susdata\BRCC\BRCC\DATA
ENTRY\DataEntrymAIN2_be.mdb"

with

appAccess.OpenCurrentDatabase "I:\Susdata\BRCC\BRCC\DATA
ENTRY\DataEntrymAIN2_be.mdb", True

 

[Guest]

Thanks very much! It worked! I changed it to the below code.

If Len(Dir(NewFolder))=0 Then
Set dbNew=DBEngine.Workspaces(0).CreateDatabase(NewFolder, dbLangGeneral)
Set dbNew=Nothing

appAccess.OpenCurrentDatabase "I:\Susdata\BRCC\BRCC\DATA
ENTRY\DataEntrymAIN2_be.mdb", True

 

[Douglas J. Steele]

Using the Call approach (i.e. replacing the two lines

Set dbNew=DBEngine.Workspaces(0).CreateDatabase(NewFolder, dbLangGeneral)
Set dbNew=Nothing

with

Call DBEngine.Workspaces(0).CreateDatabase(NewFolder, dbLangGeneral)

) would probably be slightly more efficient, but not enough to be noticable.