J
James
I need this code to delete the old table and place the new table in the
tables container with the old table name. I am not that experienced with
modules. I have posted on here befor and they just gave me the answer to
use DoCmd. I was told that you can use Container().Update, but I could not
find it in Access or VB Help. Can someone tell me how and where to put this
code. There is a Module named modMain and a the Class Object for
frmBackupRestore. I think that the one below should serfice, If not please
let me know.
Below is Class Module cBackupRestore:
Option Compare Database
Option Explicit
Private mintErrorTrap As Integer
Private mstrRootFolder As String
Private mstrDBName As String
Private Const mconTABLES = "tables"
Private Const mconQUERIES = "queries"
Private Const mconFORMS = "forms"
Private Const mconREPORTS = "reports"
Private Const mconMACROS = "macros"
Private Const mconMODULES = "modules"
Private Const mconBACKUP_FOLDER = "backups.wzb"
'Stores complete path to backup folders
Private mcolFolders As Collection
'the files in a specific backup folder
Private mcolFiles As Collection
Public Function GetFileNames(ObjectType As Integer) As String
'For a particular object type, return all the backup
'files present in a backup folder as a string
'
On Error GoTo ErrHandler
Dim colFiles As Collection
Dim strFile As String
Dim strFolder As String
Dim i As Integer
Dim strOut As String
'First, read the files present in object's backup folder
Call sInitCollection(ObjectType)
'Now return all the names read previously as formatted
'for a two column listbox, first col.=VersionNumber and
'SecondColumn=actual FileName w/o the version info
strOut = "Version;FileName;"
For i = 1 To mcolFiles.count
strFile = mcolFiles.Item(i)
If (ObjectType = acTable) Then
strOut = strOut _
& Mid$(strFile, InStr(strFile, "_") + 1, InStr(strFile,
".") - InStr(strFile, "_") - 1) _
& ";" & Left$(strFile, InStr(strFile, "_") - 1) & ";"
Else
strOut = strOut _
& Right$(strFile, Len(strFile) - InStr(strFile, ".")) _
& ";" & Left$(strFile, InStr(strFile, ".") - 1) & ";"
End If
Next
strOut = Left$(strOut, Len(strOut) - 1)
GetFileNames = strOut
ExitHere:
Exit Function
ErrHandler:
GetFileNames = vbNullString
Resume ExitHere
End Function
Private Sub sInitCollection(intObjectType As Integer)
Dim strFile As String
Dim strFolder As String
'refresh folders collection
Call sCheckSubDir(False)
'Now get the files for this particular index
Set mcolFiles = New Collection
strFolder = mcolFolders(intObjectType & vbNullString) & "\"
strFile = Dir(strFolder, vbNormal)
Do While Not strFile = vbNullString
mcolFiles.Add Item:=strFile, key:=strFile
strFile = Dir
Loop
End Sub
Public Function ImportObject(ObjectType As Integer, VersionNumber As
Integer, FileName As String) As String
On Error GoTo ErrHandler
Dim strFilePath As String
Dim strNewObjectName As String
Dim strImportName As String
'First read all files for this object
Call sInitCollection(ObjectType)
'get teh complete path to the object folder being asked for
If (ObjectType = acTable) Then
strFilePath = mcolFolders(ObjectType & vbNullString) & "\" _
& FileName & "_" & VersionNumber & ".txt"
Else
strFilePath = mcolFolders(ObjectType & vbNullString) & "\" _
& FileName & "." & VersionNumber
End If
'Make sure we know under what name was the object imported
strNewObjectName = Application.Run("acwzmain.wlib_stUniqueDocName", _
FileName, ObjectType)
If Not strNewObjectName = FileName Then
strImportName = strNewObjectName
Else
strImportName = FileName
End If
If (ObjectType = acTable) Then
DoCmd.TransferText acImportDelim, , strImportName, strFilePath, True
Else
Application.LoadFromText ObjectType, _
strImportName, _
strFilePath
End If
ImportObject = strImportName
ExitHere:
Exit Function
ErrHandler:
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, vbOKOnly Or
vbCritical
ImportObject = vbNullString
Resume ExitHere
End Function
Public Sub ExportObjects(rsDynaset As Recordset)
'SaveAsText all objects whose names are present
'in this recordset and update the revision number
'
On Error GoTo ErrHandler
Dim strDestination As String
'check for specific object folders underneath mconBACKUP_FOLDER
'Create any if need be
Call sCheckSubDir(True)
With rsDynaset
Do While Not .EOF
'Get the folder path
If (!ObjectType <> acTable) Then
strDestination = mcolFolders(!ObjectType & vbNullString) & "\" _
& !ObjectName & "." &
!RevisionNumber
Else
strDestination = mcolFolders(!ObjectType & vbNullString) & "\" _
& !ObjectName & "_" &
!RevisionNumber & ".txt"
End If
Call SysCmd(acSysCmdSetStatus, "Exporting " & pconQ & !ObjectName &
pconQ & "....")
If !ObjectType = 0 Then
'If it's a table object, use TransferText instead.
DoCmd.TransferText acExportDelim, , !ObjectName, strDestination,
True
Else
'Otherwise call the undocumented SaveAsText method
'Call Application.SaveAsText(!ObjectType, !ObjectName,
strDestination)
End If
'Now increment the RevisionNumber for
'the next time around.
.Edit
!RevisionNumber = !RevisionNumber + 1
!BackupRecommended = False
!LastBackupTimeStamp = Now()
.Update
.MoveNext
Loop
End With
ExitHere:
On Error Resume Next
Call SysCmd(acSysCmdClearStatus)
Exit Sub
ErrHandler:
Err.Raise pconERR_BASE + 4, "cBackupRestore::ExportObjects", _
"Specified object does not exist in source database."
Resume ExitHere
End Sub
Public Property Let FolderPath(Value As String)
'Where do we want to place all the exports?
'
'If the folder doesn't exist, return an error
If Dir(Value, vbDirectory) = vbNullString Then _
Err.Raise pconERR_BASE + 1, "cBackupRestore::FolderPath", _
"Invalid path specified"
mstrRootFolder = Value
If Not Right$(mstrRootFolder, 1) = "\" Then _
mstrRootFolder = mstrRootFolder & "\"
End Property
Private Sub sCheckSubDir(blnCreateSubFolders As Boolean)
On Error GoTo ErrHandler
Dim strPath As String
strPath = mstrRootFolder & mconBACKUP_FOLDER & "\"
'If the backup folder (mconBACKUP_FOLDER) doesn't exist
'under this folder, create it
If Dir(mstrRootFolder & mconBACKUP_FOLDER, vbDirectory) = vbNullString
Then
If blnCreateSubFolders Then
Call MkDir(mstrRootFolder & mconBACKUP_FOLDER)
End If
End If
'If object specific folders don't exist under mconBACKUP_FOLDER
'Create them on the fly if needed (blnCreateSubFolders)
If Dir(strPath & mconTABLES, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconTABLES)
End If
End If
mcolFolders.Add Item:=strPath & mconTABLES, key:=acTable & vbNullString
If Dir(strPath & mconQUERIES, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconQUERIES)
End If
End If
mcolFolders.Add Item:=strPath & mconQUERIES, key:=acQuery & vbNullString
If Dir(strPath & mconFORMS, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconFORMS)
End If
End If
mcolFolders.Add Item:=strPath & mconFORMS, key:=acForm & vbNullString
If Dir(strPath & mconREPORTS, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconREPORTS)
End If
End If
mcolFolders.Add Item:=strPath & mconREPORTS, key:=acReport & vbNullString
If Dir(strPath & mconMACROS, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconMACROS)
End If
End If
mcolFolders.Add Item:=strPath & mconMACROS, key:=acMacro & vbNullString
If Dir(strPath & mconMODULES, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconMODULES)
End If
End If
mcolFolders.Add Item:=strPath & mconMODULES, key:=acModule & vbNullString
ExitHere:
Exit Sub
ErrHandler:
Err.Raise pconERR_BASE + 2, "cBackupRestore::sCreateSubDirs", _
"Error: " & Err.Description & "(" & Err.Number & ")"
Resume ExitHere
End Sub
Private Sub Class_Initialize()
mintErrorTrap = Application.GetOption("Error Trapping")
Call Application.SetOption("Error Trapping", 2)
Set mcolFolders = New Collection
End Sub
Private Sub Class_Terminate()
Call Application.SetOption("Error Trapping", mintErrorTrap)
Set mcolFolders = Nothing
End Sub
tables container with the old table name. I am not that experienced with
modules. I have posted on here befor and they just gave me the answer to
use DoCmd. I was told that you can use Container().Update, but I could not
find it in Access or VB Help. Can someone tell me how and where to put this
code. There is a Module named modMain and a the Class Object for
frmBackupRestore. I think that the one below should serfice, If not please
let me know.
Below is Class Module cBackupRestore:
Option Compare Database
Option Explicit
Private mintErrorTrap As Integer
Private mstrRootFolder As String
Private mstrDBName As String
Private Const mconTABLES = "tables"
Private Const mconQUERIES = "queries"
Private Const mconFORMS = "forms"
Private Const mconREPORTS = "reports"
Private Const mconMACROS = "macros"
Private Const mconMODULES = "modules"
Private Const mconBACKUP_FOLDER = "backups.wzb"
'Stores complete path to backup folders
Private mcolFolders As Collection
'the files in a specific backup folder
Private mcolFiles As Collection
Public Function GetFileNames(ObjectType As Integer) As String
'For a particular object type, return all the backup
'files present in a backup folder as a string
'
On Error GoTo ErrHandler
Dim colFiles As Collection
Dim strFile As String
Dim strFolder As String
Dim i As Integer
Dim strOut As String
'First, read the files present in object's backup folder
Call sInitCollection(ObjectType)
'Now return all the names read previously as formatted
'for a two column listbox, first col.=VersionNumber and
'SecondColumn=actual FileName w/o the version info
strOut = "Version;FileName;"
For i = 1 To mcolFiles.count
strFile = mcolFiles.Item(i)
If (ObjectType = acTable) Then
strOut = strOut _
& Mid$(strFile, InStr(strFile, "_") + 1, InStr(strFile,
".") - InStr(strFile, "_") - 1) _
& ";" & Left$(strFile, InStr(strFile, "_") - 1) & ";"
Else
strOut = strOut _
& Right$(strFile, Len(strFile) - InStr(strFile, ".")) _
& ";" & Left$(strFile, InStr(strFile, ".") - 1) & ";"
End If
Next
strOut = Left$(strOut, Len(strOut) - 1)
GetFileNames = strOut
ExitHere:
Exit Function
ErrHandler:
GetFileNames = vbNullString
Resume ExitHere
End Function
Private Sub sInitCollection(intObjectType As Integer)
Dim strFile As String
Dim strFolder As String
'refresh folders collection
Call sCheckSubDir(False)
'Now get the files for this particular index
Set mcolFiles = New Collection
strFolder = mcolFolders(intObjectType & vbNullString) & "\"
strFile = Dir(strFolder, vbNormal)
Do While Not strFile = vbNullString
mcolFiles.Add Item:=strFile, key:=strFile
strFile = Dir
Loop
End Sub
Public Function ImportObject(ObjectType As Integer, VersionNumber As
Integer, FileName As String) As String
On Error GoTo ErrHandler
Dim strFilePath As String
Dim strNewObjectName As String
Dim strImportName As String
'First read all files for this object
Call sInitCollection(ObjectType)
'get teh complete path to the object folder being asked for
If (ObjectType = acTable) Then
strFilePath = mcolFolders(ObjectType & vbNullString) & "\" _
& FileName & "_" & VersionNumber & ".txt"
Else
strFilePath = mcolFolders(ObjectType & vbNullString) & "\" _
& FileName & "." & VersionNumber
End If
'Make sure we know under what name was the object imported
strNewObjectName = Application.Run("acwzmain.wlib_stUniqueDocName", _
FileName, ObjectType)
If Not strNewObjectName = FileName Then
strImportName = strNewObjectName
Else
strImportName = FileName
End If
If (ObjectType = acTable) Then
DoCmd.TransferText acImportDelim, , strImportName, strFilePath, True
Else
Application.LoadFromText ObjectType, _
strImportName, _
strFilePath
End If
ImportObject = strImportName
ExitHere:
Exit Function
ErrHandler:
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, vbOKOnly Or
vbCritical
ImportObject = vbNullString
Resume ExitHere
End Function
Public Sub ExportObjects(rsDynaset As Recordset)
'SaveAsText all objects whose names are present
'in this recordset and update the revision number
'
On Error GoTo ErrHandler
Dim strDestination As String
'check for specific object folders underneath mconBACKUP_FOLDER
'Create any if need be
Call sCheckSubDir(True)
With rsDynaset
Do While Not .EOF
'Get the folder path
If (!ObjectType <> acTable) Then
strDestination = mcolFolders(!ObjectType & vbNullString) & "\" _
& !ObjectName & "." &
!RevisionNumber
Else
strDestination = mcolFolders(!ObjectType & vbNullString) & "\" _
& !ObjectName & "_" &
!RevisionNumber & ".txt"
End If
Call SysCmd(acSysCmdSetStatus, "Exporting " & pconQ & !ObjectName &
pconQ & "....")
If !ObjectType = 0 Then
'If it's a table object, use TransferText instead.
DoCmd.TransferText acExportDelim, , !ObjectName, strDestination,
True
Else
'Otherwise call the undocumented SaveAsText method
'Call Application.SaveAsText(!ObjectType, !ObjectName,
strDestination)
End If
'Now increment the RevisionNumber for
'the next time around.
.Edit
!RevisionNumber = !RevisionNumber + 1
!BackupRecommended = False
!LastBackupTimeStamp = Now()
.Update
.MoveNext
Loop
End With
ExitHere:
On Error Resume Next
Call SysCmd(acSysCmdClearStatus)
Exit Sub
ErrHandler:
Err.Raise pconERR_BASE + 4, "cBackupRestore::ExportObjects", _
"Specified object does not exist in source database."
Resume ExitHere
End Sub
Public Property Let FolderPath(Value As String)
'Where do we want to place all the exports?
'
'If the folder doesn't exist, return an error
If Dir(Value, vbDirectory) = vbNullString Then _
Err.Raise pconERR_BASE + 1, "cBackupRestore::FolderPath", _
"Invalid path specified"
mstrRootFolder = Value
If Not Right$(mstrRootFolder, 1) = "\" Then _
mstrRootFolder = mstrRootFolder & "\"
End Property
Private Sub sCheckSubDir(blnCreateSubFolders As Boolean)
On Error GoTo ErrHandler
Dim strPath As String
strPath = mstrRootFolder & mconBACKUP_FOLDER & "\"
'If the backup folder (mconBACKUP_FOLDER) doesn't exist
'under this folder, create it
If Dir(mstrRootFolder & mconBACKUP_FOLDER, vbDirectory) = vbNullString
Then
If blnCreateSubFolders Then
Call MkDir(mstrRootFolder & mconBACKUP_FOLDER)
End If
End If
'If object specific folders don't exist under mconBACKUP_FOLDER
'Create them on the fly if needed (blnCreateSubFolders)
If Dir(strPath & mconTABLES, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconTABLES)
End If
End If
mcolFolders.Add Item:=strPath & mconTABLES, key:=acTable & vbNullString
If Dir(strPath & mconQUERIES, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconQUERIES)
End If
End If
mcolFolders.Add Item:=strPath & mconQUERIES, key:=acQuery & vbNullString
If Dir(strPath & mconFORMS, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconFORMS)
End If
End If
mcolFolders.Add Item:=strPath & mconFORMS, key:=acForm & vbNullString
If Dir(strPath & mconREPORTS, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconREPORTS)
End If
End If
mcolFolders.Add Item:=strPath & mconREPORTS, key:=acReport & vbNullString
If Dir(strPath & mconMACROS, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconMACROS)
End If
End If
mcolFolders.Add Item:=strPath & mconMACROS, key:=acMacro & vbNullString
If Dir(strPath & mconMODULES, vbDirectory) = vbNullString Then
If blnCreateSubFolders Then
Call MkDir(strPath & mconMODULES)
End If
End If
mcolFolders.Add Item:=strPath & mconMODULES, key:=acModule & vbNullString
ExitHere:
Exit Sub
ErrHandler:
Err.Raise pconERR_BASE + 2, "cBackupRestore::sCreateSubDirs", _
"Error: " & Err.Description & "(" & Err.Number & ")"
Resume ExitHere
End Sub
Private Sub Class_Initialize()
mintErrorTrap = Application.GetOption("Error Trapping")
Call Application.SetOption("Error Trapping", 2)
Set mcolFolders = New Collection
End Sub
Private Sub Class_Terminate()
Call Application.SetOption("Error Trapping", mintErrorTrap)
Set mcolFolders = Nothing
End Sub