I am using TransferText to create text files of my tables and then restore them into another database. However, when I examine the restored tables, some of the properties are not correct. The fields and data all exist, but there are no Primary Keys, and both the Unique and Required property are incorrect in a couple of fields that I checked. There may be more, but I did not check further. Can anyone shed light on this?
This is the code to save the tables to text:
Code:
Public Sub ExportDatabaseObjects()
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
Dim td As TableDef
Dim d As Document
Dim c As Container
Dim i As Integer
Dim sExportLocation As String
Dim strSQl As String
Set db = CurrentDb()
'Archive txt files from previous run of this code
MoveTxtFilesToArchiveFolder
strSQl = "Delete * from _ApplicationObjectList"
CurrentDb.Execute strSQl, dbFailOnError
sExportLocation = Application.CurrentProject.Path & "\ExportDatabaseObjectsToFiles\"
For Each td In db.TableDefs 'Tables
If Left(td.Name, 4) <> "MSys" And td.Name <> "_ApplicationObjectList" Then
strSQl = "insert into _ApplicationObjectList ( ObjType, ObjName, ObjLocation ) " & _
"select " & acTable & " as ObjType, '" & td.Name & "' as ObjName, '" & sExportLocation & "Table_" & td.Name & ".txt" & "' as ObjLocation;"
db.Execute strSQl, dbSeeChanges
DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".txt", True
End If
Next td
'Other objects get exported here
Set db = Nothing
Set c = Nothing
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
Exit_ExportDatabaseObjects:
Exit Sub
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Sub
This is the code to restore the tables from text:
Code:
Sub RestoreDatabaseObjects()
On Error GoTo err_Handler
Dim strSQl As String
Dim rs As DAO.Recordset
strSQl = "select * from _ApplicationObjectList"
Set rs = CurrentDb.OpenRecordset(strSQl)
If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
While (Not rs.EOF)
Debug.Print rs.Fields("ObjName")
If rs.Fields("ObjType") = acTable Then
DoCmd.TransferText acImportDelim, , rs.Fields("ObjName"), rs.Fields("ObjLocation"), True
Else
Application.LoadFromText rs.Fields("ObjType"), rs.Fields("ObjName"), rs.Fields("ObjLocation")
End If
rs.MoveNext
Wend
End If
rs.Close
Set rs = Nothing
Exit_Handler:
Exit Sub
err_Handler:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure RestoreDatabaseObjects"
Resume Exit_Handler
End Sub