R
rhese
I've got a database system that is composed of 3 levels of databases:
National, State, and Local. Each mdb is an exact copy of the other,
except for the amount of data contained. The National contains all
records, the State - only records for that state, and the Local - only
records for that office. The table structure and all the forms & code
are the same.
The National and State level databases have a button that allow the
user to export out the next lower level. i.e., National wants to
create new State-level databases and State-level wants to create new
Local-level databases, and I have code that will do this splendidly.
However, the same "Export Sub Databases" button shows up in the Local-
level database, and my client is concerned this will cause confusion.
I have tried to code in a routine at the beginning of the Export Sub
Databases process that hides the button in the current (State-level)
database before using an iterative .Copyfile loop to create the Local-
level databases, and then restore the button at the end of the Sub.
But, even though the button does disappear in the current database
before the copying begins, it is still visible in each Local-level
database.
Can anyone tell me why this doesn't work? I'm working in Access 2003
but saving these databases as Access 2000. Below is the code, with
the portions dealing with hiding the button bracketed by "***". Thank
you for any help you can provide.
--Rhese
Private Sub bExportLocal_Click()
On Error GoTo bExport_LocalErr
Dim strSQL As String
Dim strDelSQL As String
Dim strLocal As String
Dim strState As String
Dim strSourceDb As String
Dim strDestinationDb As String
Dim strPath As String
Dim intRev As Long
Dim fs As Object
Dim qdfLocals As QueryDef
Dim rstLocals As DAO.Recordset
Dim rsState As DAO.Recordset
Dim dbLocal As Database
DoCmd.Hourglass True
'****************************************************
'Temporarily hide the Export Sub Databases button on fExport_Database
in the current database
'so it won't show up in the local databases.
Forms!fExport_Database!bExit.SetFocus
Forms!fExport_Database!bExportSubs.Visible = False
Forms!fExport_Database!lblExportSubs.Visible = False
Forms!fExport_Database.Repaint
DoCmd.Save acForm, "fExport_Database"
'****************************************************
'Get the name and path of current database
strSourceDb = CurrentDb().Name
intRev = InStrRev(strSourceDb, "\", , 1)
strPath = Left(strSourceDb, intRev)
'Get unique list of Offices for this State that have data
strSQL = "SELECT tSpecies_In_FDOffice.OfficeCode FROM
tSpecies_In_FDOffice " & _
"GROUP BY tSpecies_In_FDOffice.OfficeCode ORDER BY
tSpecies_In_FDOffice.OfficeCode;"
Set qdfLocals = CurrentDb().CreateQueryDef("", strSQL)
Set rstLocals = qdfLocals.OpenRecordset(dbOpenForwardOnly)
'Figure out which State this is
strLocal = rstLocals![OfficeCode]
Set rsState = CurrentDb().OpenRecordset("tFD_Offices", dbOpenDynaset)
With rsState
.FindFirst "[OfficeCode] = " & "'" & strLocal & "'"
strState = ![StateCode]
.Close
End With
'Loop though Local Offices and make copies of the database with the
State and Office as part of the name
With rstLocals
While Not .EOF
strDestinationDb = strPath & strState & "_" & strLocal & "_" &
Str(Year(Now())) & ".mdb"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile strSourceDb, strDestinationDb
If Err.Number = 0 Then 'Copy was successful
'Now open new db, and delete out anything that doesn't
relate to this Office
Set dbLocal = DBEngine.OpenDatabase(strDestinationDb,
True, False)
strDelSQL = "DELETE tSpecies_In_State.* FROM
tSpecies_In_State WHERE (((tSpecies_In_State.StateCode)<>'" & strState
& "'));"
dbLocal.Execute strDelSQL, dbFailOnError
strDelSQL = "DELETE tSpecies_In_FDOffice.* FROM
tSpecies_In_FDOffice WHERE (((tSpecies_In_FDOffice.OfficeCode)<>'" &
strLocal & "'));"
dbLocal.Execute strDelSQL, dbFailOnError
strDelSQL = "DELETE tGlobal.* FROM tGlobal WHERE
(((tGlobal.OfficeCode)<>'" & strLocal & "'));"
dbLocal.Execute strDelSQL, dbFailOnError
strDelSQL = "DELETE tFD_Offices.* FROM tFD_Offices WHERE
(((tFD_Offices.OfficeCode)<>'" & strLocal & "'));"
dbLocal.Execute strDelSQL, dbFailOnError
'Change any Record Status flags from "New" or "Updated" to
"Accepted"
strSQL = "UPDATE tPopCodeSpecies SET
tPopCodeSpecies.Sp_Record_Status = 'Accepted " & Str(Now()) & "'" & _
" WHERE (((tPopCodeSpecies.Sp_Record_Status) Like
'New*')) OR (((tPopCodeSpecies.Sp_Record_Status) Like 'Updated*'));"
dbLocal.Execute strSQL, dbFailOnError
strSQL = "UPDATE tSpecies_In_State SET
tSpecies_In_State.St_Record_Status = 'Accepted " & Str(Now()) & "'" &
_
" WHERE (((tSpecies_In_State.St_Record_Status) Like
'New*')) OR (((tSpecies_In_State.St_Record_Status) Like 'Updated*'));"
dbLocal.Execute strSQL, dbFailOnError
strSQL = "UPDATE tSpecies_In_FDOffice SET
tSpecies_In_FDOffice.Record_Status = 'Accepted " & Str(Now()) & "'" &
_
" WHERE (((tSpecies_In_FDOffice.Record_Status) Like
'New*')) OR (((tSpecies_In_FDOffice.Record_Status) Like 'Updated*'));"
dbLocal.Execute strSQL, dbFailOnError
strSQL = "UPDATE tSpecies_FDOffice_Year SET
tSpecies_FDOffice_Year.FY_RecordStatus = 'Accepted " & Str(Now()) &
"'" & _
" WHERE (((tSpecies_FDOffice_Year.FY_RecordStatus)
Like 'New*')) OR (((tSpecies_FDOffice_Year.FY_RecordStatus) Like
'Updated*'));"
dbLocal.Execute strSQL, dbFailOnError
dbLocal.Close
'Compact the new database
DBEngine.CompactDatabase strDestinationDb, strPath &
"tempDb"
fs.DeleteFile strDestinationDb
fs.CopyFile strPath & "tempDb.mdb", strDestinationDb
fs.DeleteFile strPath & "tempDb.mdb"
End If
.MoveNext
If Not .EOF Then
strLocal = ![OfficeCode]
End If
Wend
.Close
End With
'****************************************************
'Get the Export Sub Databases button back on fExport_Database in the
current database
Forms!fExport_Database!bExportSubs.Visible = True
Forms!fExport_Database!lblExportSubs.Visible = True
Forms!fExport_Database.Repaint
DoCmd.Save acForm, "fExport_Database"
'****************************************************
bExport_LocalExit:
DoCmd.Hourglass False
DoCmd.Close
Exit Sub
bExport_LocalErr:
MsgBox Err.Number & ", " & Err.Description
Resume bExport_LocalExit
End Sub
National, State, and Local. Each mdb is an exact copy of the other,
except for the amount of data contained. The National contains all
records, the State - only records for that state, and the Local - only
records for that office. The table structure and all the forms & code
are the same.
The National and State level databases have a button that allow the
user to export out the next lower level. i.e., National wants to
create new State-level databases and State-level wants to create new
Local-level databases, and I have code that will do this splendidly.
However, the same "Export Sub Databases" button shows up in the Local-
level database, and my client is concerned this will cause confusion.
I have tried to code in a routine at the beginning of the Export Sub
Databases process that hides the button in the current (State-level)
database before using an iterative .Copyfile loop to create the Local-
level databases, and then restore the button at the end of the Sub.
But, even though the button does disappear in the current database
before the copying begins, it is still visible in each Local-level
database.
Can anyone tell me why this doesn't work? I'm working in Access 2003
but saving these databases as Access 2000. Below is the code, with
the portions dealing with hiding the button bracketed by "***". Thank
you for any help you can provide.
--Rhese
Private Sub bExportLocal_Click()
On Error GoTo bExport_LocalErr
Dim strSQL As String
Dim strDelSQL As String
Dim strLocal As String
Dim strState As String
Dim strSourceDb As String
Dim strDestinationDb As String
Dim strPath As String
Dim intRev As Long
Dim fs As Object
Dim qdfLocals As QueryDef
Dim rstLocals As DAO.Recordset
Dim rsState As DAO.Recordset
Dim dbLocal As Database
DoCmd.Hourglass True
'****************************************************
'Temporarily hide the Export Sub Databases button on fExport_Database
in the current database
'so it won't show up in the local databases.
Forms!fExport_Database!bExit.SetFocus
Forms!fExport_Database!bExportSubs.Visible = False
Forms!fExport_Database!lblExportSubs.Visible = False
Forms!fExport_Database.Repaint
DoCmd.Save acForm, "fExport_Database"
'****************************************************
'Get the name and path of current database
strSourceDb = CurrentDb().Name
intRev = InStrRev(strSourceDb, "\", , 1)
strPath = Left(strSourceDb, intRev)
'Get unique list of Offices for this State that have data
strSQL = "SELECT tSpecies_In_FDOffice.OfficeCode FROM
tSpecies_In_FDOffice " & _
"GROUP BY tSpecies_In_FDOffice.OfficeCode ORDER BY
tSpecies_In_FDOffice.OfficeCode;"
Set qdfLocals = CurrentDb().CreateQueryDef("", strSQL)
Set rstLocals = qdfLocals.OpenRecordset(dbOpenForwardOnly)
'Figure out which State this is
strLocal = rstLocals![OfficeCode]
Set rsState = CurrentDb().OpenRecordset("tFD_Offices", dbOpenDynaset)
With rsState
.FindFirst "[OfficeCode] = " & "'" & strLocal & "'"
strState = ![StateCode]
.Close
End With
'Loop though Local Offices and make copies of the database with the
State and Office as part of the name
With rstLocals
While Not .EOF
strDestinationDb = strPath & strState & "_" & strLocal & "_" &
Str(Year(Now())) & ".mdb"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile strSourceDb, strDestinationDb
If Err.Number = 0 Then 'Copy was successful
'Now open new db, and delete out anything that doesn't
relate to this Office
Set dbLocal = DBEngine.OpenDatabase(strDestinationDb,
True, False)
strDelSQL = "DELETE tSpecies_In_State.* FROM
tSpecies_In_State WHERE (((tSpecies_In_State.StateCode)<>'" & strState
& "'));"
dbLocal.Execute strDelSQL, dbFailOnError
strDelSQL = "DELETE tSpecies_In_FDOffice.* FROM
tSpecies_In_FDOffice WHERE (((tSpecies_In_FDOffice.OfficeCode)<>'" &
strLocal & "'));"
dbLocal.Execute strDelSQL, dbFailOnError
strDelSQL = "DELETE tGlobal.* FROM tGlobal WHERE
(((tGlobal.OfficeCode)<>'" & strLocal & "'));"
dbLocal.Execute strDelSQL, dbFailOnError
strDelSQL = "DELETE tFD_Offices.* FROM tFD_Offices WHERE
(((tFD_Offices.OfficeCode)<>'" & strLocal & "'));"
dbLocal.Execute strDelSQL, dbFailOnError
'Change any Record Status flags from "New" or "Updated" to
"Accepted"
strSQL = "UPDATE tPopCodeSpecies SET
tPopCodeSpecies.Sp_Record_Status = 'Accepted " & Str(Now()) & "'" & _
" WHERE (((tPopCodeSpecies.Sp_Record_Status) Like
'New*')) OR (((tPopCodeSpecies.Sp_Record_Status) Like 'Updated*'));"
dbLocal.Execute strSQL, dbFailOnError
strSQL = "UPDATE tSpecies_In_State SET
tSpecies_In_State.St_Record_Status = 'Accepted " & Str(Now()) & "'" &
_
" WHERE (((tSpecies_In_State.St_Record_Status) Like
'New*')) OR (((tSpecies_In_State.St_Record_Status) Like 'Updated*'));"
dbLocal.Execute strSQL, dbFailOnError
strSQL = "UPDATE tSpecies_In_FDOffice SET
tSpecies_In_FDOffice.Record_Status = 'Accepted " & Str(Now()) & "'" &
_
" WHERE (((tSpecies_In_FDOffice.Record_Status) Like
'New*')) OR (((tSpecies_In_FDOffice.Record_Status) Like 'Updated*'));"
dbLocal.Execute strSQL, dbFailOnError
strSQL = "UPDATE tSpecies_FDOffice_Year SET
tSpecies_FDOffice_Year.FY_RecordStatus = 'Accepted " & Str(Now()) &
"'" & _
" WHERE (((tSpecies_FDOffice_Year.FY_RecordStatus)
Like 'New*')) OR (((tSpecies_FDOffice_Year.FY_RecordStatus) Like
'Updated*'));"
dbLocal.Execute strSQL, dbFailOnError
dbLocal.Close
'Compact the new database
DBEngine.CompactDatabase strDestinationDb, strPath &
"tempDb"
fs.DeleteFile strDestinationDb
fs.CopyFile strPath & "tempDb.mdb", strDestinationDb
fs.DeleteFile strPath & "tempDb.mdb"
End If
.MoveNext
If Not .EOF Then
strLocal = ![OfficeCode]
End If
Wend
.Close
End With
'****************************************************
'Get the Export Sub Databases button back on fExport_Database in the
current database
Forms!fExport_Database!bExportSubs.Visible = True
Forms!fExport_Database!lblExportSubs.Visible = True
Forms!fExport_Database.Repaint
DoCmd.Save acForm, "fExport_Database"
'****************************************************
bExport_LocalExit:
DoCmd.Hourglass False
DoCmd.Close
Exit Sub
bExport_LocalErr:
MsgBox Err.Number & ", " & Err.Description
Resume bExport_LocalExit
End Sub