Export Table Structure to Text File 5

[kathyc20]

I have 30 Access databases, with an average of
4 tables per database.

What I need to do for a client I'm working for is
to export the table structure to a text file.

Can this be done in Access. If so, how?
If not, does anyone know a good third party tool
I can get to do this?

Any help would be appreciated.

 

[OrWolf]

If you are talking about the actually table structure and not the data in the tables, then I would suggest Visio. It has a tool to import Access database structures and will create a flowchart with all of the table specifics and relationships.

 

[Quehay]

DrWolf if this is true you make happy fellow for me!

 

[Lightning]

KathyC20

Use the Analyze tool in Access.

From the database window menubar, choose
"Tools|Analyze|Documenter"

Select the Tables tab and either check the tables or use the "Select All" button. use the "Options" button to select what information you want in your report. Then click OK.

The documenter will then produce an Access report for your tables.

HTH
Lightning

 

[OrWolf]

It is true that Access can produce a text only report, but I've always found it cumbersome to work with. Visio will provide a graphical, to the point, document.

 

[Quehay]

Got to admit I'm not that thrilled with the documenter--and if you're not careful you commit to 10 min of processing and 40 pages of wasted paper. Oh lupine one, can you elaborate on the Visio steps? I have Visio (and no experience in it) and didn't find a readily apparent way of doing this (tried Tools > Macros > Extras > Database and then didn't get anywhere).

 

[OrWolf]

I'm not sure what versions it's available in. I have Visio 2000 Professional. Under the Database menu there is a 'Reverse Engineer' option. This wizard will walk you through the steps to make a connection to any database and then import tables and queries.

 

[emzadi]

do you know why i would be getting "invalid database format" when attempting to reverse engineer an Access database that works just fine? Susan M. Wagner
LAPELS
susanw@lapels.com

 

[OrWolf]

The version of Visio you are using and the version of the Access database may be incompatible. What are the versions of each?

 

[emzadi]

Bingo! Thanks! Susan M. Wagner
LAPELS
emzadi1@yahoo.com
susanw@lapels.com

 

[raskew]

Please explain a little about how you want to use the resulting text file, e.g., to create the current structure elsewhere, etc.,

 

[scking]

I was taking an Oracle course and developed a code application to read each table and field of the Access 2000 application to build the SQL Create Table scripts. They included the tablenames, field names, field types, field sizes, etc. They would be extremely easy to convert to whatever you wanted. Let me know if you have any interest and I'll post.

Steve King Growth follows a healthy professional curiosity

 

[THoey]

Steve,

Sounds like a bit of code that I might use in the future, if it would also work against Access 97 MDB's. If so, could you please send a copy to me via email?

Thanks a bunch... Terry M. Hoey
th3856@txmail.sbc.com
While I don't mind e-mail messages, please post all questions in these forums for the benefit of all members.

 

[Rick39]

Steve,
I'd also be very interested in your referenced code....please post or send email

mailto:Rick.Ochoa@f22ctf.edwards.af.mil

 

[JoeMiller]

Steve,

I'd like to see that code as well if you could email it to me also. Thanks! Joe Miller
joe.miller@flotech.net

 

[scking]

Here is the Access 2000 VBA code to build SQL create scripts for Oracle.

Steve King

Option Compare Database

Dim mintFileNbr
Type ScriptType
Line As String
End Type
Dim ScriptBuf() As ScriptType

Public Sub GetProperties()

On Error GoTo HandleErr

Dim dbsCurrent As Database
Dim oFld As Field
Dim oRel As Relation
Dim oTable As TableDef
Dim oPrp As Property
Dim intCtr As Integer
Dim intFld As Integer
Dim strType As String
Dim strRequired As String
intCtr = 0
intFld = 0

Set dbsCurrent = OpenDatabase(CurrentDb.Name)
With dbsCurrent

' Display the attributes of a TableDef object's
' fields.
For Each oTable In .TableDefs
If Left$(.TableDefs(intCtr).Name, 3) <> &quot;MSys&quot; Then
Debug.Print .TableDefs(intCtr).Name & &quot;;;;;&quot;
For Each oFld In .TableDefs(intCtr).Fields
Select Case oFld.Properties(&quot;Type&quot.Value
Case 1 ' Boolean
strType = &quot;Boolean&quot;
Case 3 ' Integer
strType = &quot;Integer&quot;
Case 4 ' Numeric
strType = &quot;Long&quot;
Case 8 ' Date
strType = &quot;Date&quot;
Case 10 ' Text
strType = &quot;Text&quot;
Case 12 ' Memo
strType = &quot;Memo&quot;
Case Else
strType = oFld.Properties(&quot;Type&quot.Value
End Select
Select Case oFld.Properties(&quot;Required&quot.Value
Case True
strRequired = &quot;* &quot;
Case False
strRequired = &quot;o &quot;
Case Else
strRequired = &quot;Unknown &quot;
End Select
Debug.Print strRequired & oFld.Name & &quot;;&quot; _
& strType & &quot; (&quot; & oFld.Properties(&quot;Size&quot.Value & &quot;&quot; _
& oFld.Properties(&quot;Description&quot.Value & &quot;;&quot; _
& oFld.Properties(&quot;ValidationRule&quot.Value & &quot;;&quot; _
& oFld.Properties(&quot;ValidationText&quot.Value
Next oFld
End If
intCtr = intCtr + 1
Next oTable

' Display the attributes of the Northwind database's
' relations.
Debug.Print .Name & &quot;;&quot;

For Each oRel In .Relations
Debug.Print oRel.Name & &quot; = &quot; & _
oRel.Attributes
Next oRel

Debug.Print vbCrLf

.Close
End With

Exit_Proc:

Set dbsCurrent = Nothing
Set oFld = Nothing
Set oRel = Nothing
Set oTable = Nothing
Set oPrp = Nothing
Exit Sub

HandleErr:
Select Case Err.Number
Case 3265, 3270
Resume Next
End Select

End Sub
Sub FieldX()

Dim dbsCurrent As Database
Dim rstEmployees As Recordset
Dim fldTableDef As Field
Dim fldQueryDef As Field
Dim fldRecordset As Field
Dim fldRelation As Field
Dim fldIndex As Field
Dim prpLoop As Property
Dim oTable As TableDef
Dim intCtr As Integer

Set dbsCurrent = OpenDatabase(CurrentDb.Name)
Set oTable = dbsCurrent.TableDefs(0)
intCtr = 0
' Assign a Field object from different Fields
' collections to object variables.
For Each oTable In dbsCurrent.TableDefs
intCtr = intCtr + 1
Set oTable = dbsCurrent.TableDefs(intCtr)
Set fldTableDef = _
dbsCurrent.TableDefs(intCtr).Fields(0)
Set fldRelation = dbsCurrent.Relations(0).Fields(0)
Set fldIndex = _
dbsCurrent.TableDefs(0).Indexes(0).Fields(0)
Next oTable
' Print report.
FieldOutput &quot;TableDef&quot;, fldTableDef
FieldOutput &quot;Relation&quot;, fldRelation

dbsCurrent.Close

End Sub

Sub FieldOutput(strTemp As String, fldTemp As Field)
On Error GoTo HandleErr:

' Report function for FieldX.

Dim prpLoop As Property

Debug.Print &quot;Valid Field properties in &quot; & strTemp

' Enumerate Properties collection of passed Field
' object.
For Each prpLoop In fldTemp.Properties
' Some properties are invalid in certain
' contexts (the Value property in the Fields
' collection of a TableDef for example). Any
' attempt to use an invalid property will
' trigger an error.
If prpLoop.Name = &quot;Description&quot; Then
Debug.Print &quot; &quot; & prpLoop.Name & &quot; = &quot; & _
prpLoop.Value
End If
Next prpLoop

Exit_Proc:
Exit Sub

HandleErr:
MsgBox Err.Number & &quot;, &quot; & Err.Description
Resume Exit_Proc
Resume
End Sub

Public Sub CreateOracleTableScript(Optional strFilename As String)

On Error GoTo HandleErr

Dim dbsCurrent As Database
Dim oFld As Field
Dim oRel As Relation
Dim oTable As TableDef
Dim oPrp As Property
Dim intTableCount As Integer
Dim intCtr As Integer
Dim intFld As Integer
Dim intTab1 As Integer
Dim intTab2 As Integer
Dim intLastCommaPtr As Integer
Dim intSize As Integer
Dim intSpaces As Integer
Dim strType As String
Dim strSize As String
Dim strOutput As String
Dim strRequired As String
Dim strDescription As String
Dim RetVal

intTableCount = 0
intCtr = 0
intTab1 = 25
intTab2 = 50

Set dbsCurrent = OpenDatabase(CurrentDb.Name)
With dbsCurrent
mintFileNbr = FreeFile()
Open strFilename For Output As #mintFileNbr
' Display the attributes of a TableDef object's
' fields
For Each oTable In .TableDefs
If Left$(.TableDefs(intCtr).Name, 4) <> &quot;MSys&quot; Then
Debug.Print &quot; Creating &quot; & FormatTableName(.TableDefs(intCtr).Name)
intTableCount = intTableCount + 1
strOutput = &quot;drop table &quot; & FormatTableName(.TableDefs(intCtr).Name) & &quot;;&quot; & vbCr
strOutput = strOutput & &quot;create table &quot; & FormatTableName(.TableDefs(intCtr).Name) & vbCr & &quot; (&quot;
'Write #mintFileNbr, strOutput
intFld = 0
For Each oFld In .TableDefs(intCtr).Fields
intFld = intFld + 1
If intFld > 1 Then
strOutput = strOutput & &quot; &quot;
End If
intSize = 4
Select Case oFld.Properties(&quot;Type&quot.Value
Case 1 ' Boolean
strType = &quot;Char(1)&quot;
strSize = &quot;&quot;
Case 3 ' Integer
strType = &quot;number&quot;
strSize = &quot;(&quot; & 5 & &quot&quot;
Case 4 ' Numeric
strType = &quot;number&quot;
strSize = &quot;(&quot; & oFld.Properties(&quot;Size&quot.Value & &quot&quot;
Case 8 ' Date
strType = &quot;date&quot;
strSize = &quot;&quot;
Case 10 ' Text
strType = &quot;varchar2&quot;
strSize = &quot;(&quot; & oFld.Properties(&quot;Size&quot.Value & &quot&quot;
Case 12 ' Memo
strType = &quot;varchar2&quot;
strSize = &quot;&quot;
Case Else
strType = &quot;varchar2&quot;
strSize = &quot;(&quot; & oFld.Properties(&quot;Size&quot.Value & &quot&quot;
End Select

Select Case oFld.Properties(&quot;Required&quot.Value
Case True
strRequired = &quot; not null&quot;
Case False
strRequired = &quot;&quot;
Case Else
strRequired = &quot;&quot;
End Select
intSize = intSize + Len(oFld.Name)
If intSize < intTab1 Then
intSpaces = intTab1 - intSize
strOutput = strOutput & oFld.Name & Space(intSpaces) _
& strType & strSize & strRequired
intSize = intSize + intSpaces + Len(strType) + Len(strSize) + Len(strRequired)
intSpaces = intTab2 - intSize
If Len(oFld.Properties(&quot;Description&quot.Value) > 0 Then
intSpaces = intTab2 - intSize - 2
strDescription = &quot;,&quot; & Space(intSpaces) & &quot;--&quot; _
& Mid$(oFld.Properties(&quot;Description&quot.Value, 1, 28) & vbCrLf
strOutput = strOutput & strDescription
Else
strOutput = strOutput & vbCr
End If
Else

End If
Next oFld
End If
intCtr = intCtr + 1
If InStr(1, strOutput, strDescription) Then
intLastCommaPtr = InStr(1, strOutput, strDescription)
strOutput = Mid$(strOutput, 1, Len(strOutput) - Len(strDescription))
strDescription = &quot; &quot; & Mid$(strDescription, 2)
strOutput = strOutput & strDescription & &quot; );&quot; & vbCrLf
End If
'strOutput = Mid$(strOutput, 1, Len(strOutput) - 3) & vbCrLf & &quot;&quot; & vbCrLf
Write #mintFileNbr, strOutput
Next oTable

Close #mintFileNbr
RetVal = Shell(&quot;c:\Program Files\Accessories\Wordpad.exe &quot; & strFilename, vbMaximizedFocus)
.Close
End With

MsgBox &quot;Completed creation of &quot; & intTableCount & &quot; Oracle tables.&quot;
Exit_Proc:

Set dbsCurrent = Nothing
Set oFld = Nothing
Set oRel = Nothing
Set oTable = Nothing
Set oPrp = Nothing
Exit Sub

HandleErr:
Select Case Err.Number
Case 3265, 3270
Resume Next
End Select
MsgBox &quot;Error: &quot; & Err.Number & &quot;, &quot; & Err.Description
Resume Exit_Proc
Resume

End Sub

Public Sub InitScriptLine()

ReDim Preserve ScriptBuf(UBound(ScriptBuf) + 1)

End Sub

Public Function GetScriptLines() As String

Dim intCtr As Integer
Dim intFileNbr As Integer
Dim strTemp As String



For intCtr = 0 To UBound(ScriptBuf)
Debug.Print ScriptBuf(intCtr).Line
strTemp = ScriptBuf(intCtr).Line & vbCrLf
Next intCtr

GetScriptLines = strTemp
Write #intFileNbr, strTemp

End Function

Public Function FormatTableName(strWord As String) As String

Dim strTemp As String
Dim intPtr As String

intPtr = InStr(1, strWord, &quot; &quot
Do While intPtr > 0
strTemp = Mid$(strWord, 1, intPtr - 1)
strTemp = strTemp & &quot;_&quot;
strTemp = strTemp & Mid$(strWord, intPtr + 1)
strWord = strTemp
intPtr = InStr(1, strWord, &quot; &quot
Loop
FormatTableName = LCase(strWord) & vbCrLf

End Function

Public Sub CreateInsertSQL(Optional strFilename As String = &quot;CreateInsertSQL.txt&quot

On Error GoTo HandleErr

Dim dbsCurrent As Database
Dim oRcds As Recordset
Dim oFld As Field
Dim oRel As Relation
Dim oTable As TableDef
Dim oPrp As Property
Dim intCtr As Integer
Dim intFld As Integer
Dim intTab1 As Integer
Dim intTab2 As Integer
Dim intSize As Integer
Dim intSpaces As Integer
Dim strType As String
Dim strSize As String
Dim strHeader As String
Dim strFields As String
Dim strOutput As String
Dim strValues As String
Dim strRequired As String
Dim RetVal

intCtr = 0
intTab1 = 25
intTab2 = 50

Set dbsCurrent = OpenDatabase(CurrentDb.Name)
With dbsCurrent
mintFileNbr = FreeFile()
Open strFilename For Output As #mintFileNbr
' Display the attributes of a TableDef object's
' fields
For Each oTable In .TableDefs
If Left$(.TableDefs(intCtr).Name, 4) <> &quot;MSys&quot; Then
Set oRcds = dbsCurrent.OpenRecordset(.TableDefs(intCtr).Name)
If oRcds.RecordCount <> 0 Then
oRcds.MoveFirst
Do While Not oRcds.EOF
strFields = &quot; (&quot;
strValues = &quot; VALUES(&quot;
'Write #mintFileNbr, strOutput
intFld = 0
strHeader = &quot;INSERT INTO &quot; & FormatTableName(.TableDefs(intCtr).Name)
For Each oFld In .TableDefs(intCtr).Fields
If intFld = 0 Then
strFields = strFields & oFld.Properties(&quot;Name&quot.Value
strValues = strValues & GetFieldValue(oFld, oRcds.Fields(intFld).Value)
Else
strFields = strFields & &quot;, &quot; & oFld.Properties(&quot;Name&quot.Value
strValues = strValues & &quot;, &quot; & GetFieldValue(oFld, Nz(oRcds.Fields(intFld).Value, &quot;&quot)
End If
intFld = intFld + 1
DoEvents
Next oFld
strFields = strFields & &quot&quot; & vbCrLf
strValues = strValues & &quot;&quot;
strOutput = strHeader _
& &quot; &quot; & strFields _
& &quot; &quot; & strValues & vbCr
Write #mintFileNbr, strOutput
oRcds.MoveNext
DoEvents
Loop
End If
End If
intCtr = intCtr + 1
Next oTable

Close #mintFileNbr
RetVal = Shell(&quot;c:\Program Files\Accessories\Wordpad.exe &quot; & strFilename, vbMaximizedFocus)
.Close
End With

Exit_Proc:

Set dbsCurrent = Nothing
Set oFld = Nothing
Set oRel = Nothing
Set oTable = Nothing
Set oPrp = Nothing
Set oRcds = Nothing
Close
Exit Sub

HandleErr:
Select Case Err.Number
Case 3265, 3270
Resume Next
End Select
MsgBox &quot;Error: &quot; & Err.Number & &quot;, &quot; & Err.Description
Resume Exit_Proc
Resume

End Sub

Public Sub FieldProperties()

Dim dbsCurrent As Database
Dim oFld As Field
Dim oTable As TableDef
Dim oPrp As Property
Dim intCtr As Integer
Dim intCtr2 As Integer

On Error GoTo HandleErr

intCtr = 0
Set dbsCurrent = OpenDatabase(CurrentDb.Name)
With dbsCurrent
For Each oTable In .TableDefs
intCtr = intCtr + 1
If Left$(.TableDefs(intCtr).Name, 4) <> &quot;MSys&quot; Then
Debug.Print &quot;Table(&quot; & .TableDefs(intCtr).Name & &quot&quot;
Debug.Print &quot;-------------------------&quot;
For Each oFld In .TableDefs(intCtr).Fields
intCtr2 = 0
Debug.Print &quot;SourceField (&quot; & oFld.SourceField & &quot&quot;
Debug.Print &quot;-------------------------&quot;
For intCtr2 = 1 To oFld.Properties.Count
Debug.Print intCtr2 & &quot &quot; & oFld.Properties(intCtr2).Name _
& &quot; Value: &quot; & oFld.Properties(intCtr2).Value
intCtr2 = intCtr2 + 1
Next intCtr2
Debug.Print vbCrLf
Next oFld
End If
Exit Sub
Next oTable
End With

Exit_Proc:
Exit Sub

HandleErr:
MsgBox Err.Number & &quot;, &quot; & Err.Description
Resume Exit_Proc:
Resume

End Sub

Public Function GetFieldValue(oField As Field, strValue As String) As String

Const BOOL As Integer = 1
Const INTGR As Integer = 3
Const NBR As Integer = 4
Const DT As Integer = 8
Const TXT As Integer = 10
Const MEMO As Integer = 12
Dim strResult As String

On Error GoTo HandleErr

Select Case oField.Properties(&quot;Type&quot.Value
Case INTGR, NBR ' Boolean
strResult = strValue
Case DT ' Date
If Len(strValue) < 8 Then
' Ensure you have a valid 8 character date DD/MM/YY
' Check for M/... And insert zero
If Mid$(strValue, 2, 1) = &quot;/&quot; Then
strValue = &quot;0&quot; & strValue
End If
' Check for MM/D/YY And insert zero
If Mid$(strValue, 5, 1) = &quot;/&quot; Then
strValue = Mid$(strValue, 1, 3) _
& &quot;0&quot; _
& Mid$(strValue, 4)
End If
End If
' Don't use to_date on an empty date
If Len(strValue) > 4 Then
strResult = &quot;to_date('&quot; & strValue & &quot;', 'DD/MM/RR')&quot;
Else
strResult = &quot;''&quot;
End If
Case TXT, MEMO ' Text
strResult = &quot;'&quot; & DoubleUp(strValue) & &quot;'&quot;
Case BOOL
If oField.Properties(&quot;Type&quot.Value = False Then
strResult = &quot;N&quot;
Else
strResult = &quot;Y&quot;
End If
Case Else
strResult = &quot;'&quot; & DoubleUp(strValue) & &quot;'&quot;
End Select
GetFieldValue = strResult
'Debug.Print strResult

Exit_Proc:
Exit Function

HandleErr:
MsgBox Err.Number & &quot;, &quot; & Err.Description & vbCr _
& &quot;GetFieldValue&quot;
Resume Exit_Proc:
Resume

End Function
Public Function DoubleUp(strTextIn As String) As String

Dim SGLQUOTE1
Dim SGLQUOTE2
Dim intPtr1 As Integer

On Error GoTo HandleErr

SGLQUOTE1 = Chr(39)
SGLQUOTE2 = Chr(39) & Chr(39)

intPtr1 = 1
If InStr(1, strTextIn, SGLQUOTE1) Then
Do While InStr(intPtr1, strTextIn, SGLQUOTE1)
intPtr1 = InStr(intPtr1, strTextIn, SGLQUOTE1)
strTextIn = Left$(strTextIn, intPtr1 - 1) _
& SGLQUOTE2 & Mid$(strTextIn, intPtr1 + 1)
intPtr1 = intPtr1 + 2
Loop
DoubleUp = strTextIn
Else
DoubleUp = strTextIn
End If
Exit_Proc:
Exit Function

HandleErr:
MsgBox Err.Number & &quot;, &quot; & Err.Description & vbCr _
& &quot;DoubleUp&quot;
Resume Exit_Proc:
Resume

End Function Growth follows a healthy professional curiosity

 

[THoey]

Steve, the only thing I didn't see is an an example of how you called this function. I could probably figure it out, but I have about spent all the time I can spare on it today. If you don't get a chance to post an example, I'll look into it later.

BTW, I did compile the code under Access 97 and after removing a couple of carriage returns, it compiled cleanly.

Thanks again... Terry M. Hoey
th3856@txmail.sbc.com
While I don't mind e-mail messages, please post all questions in these forums for the benefit of all members.

 

[scking]

I've discovered this was an earlier version of the code I mentioned. It works with Access97, creates the files, and opens them in notepad. The file needs some manual processing to remove quotes and carriage returns. I'll try to find the most current and post it. The most current resolves all the formatting issues.

There are two main subs in the code. All the others are called from within them. To run, open the debug/immediate window and enter:

Call CreateOracleTableScript(&quot;c:\MyCreateTableScript.sql&quot
CreateInsertSQL(&quot;c:\MyCreateInsertScript.sql&quot

Filenames are optional.

Steve King Growth follows a healthy professional curiosity

 

[MichaelRed]

If Left$(.TableDefs(intCtr).Name, 3) <> &quot;MSys&quot; Then
                                  ^      ^^^^

not to get picky, but this is not going to be very useful. The

left(???, 3) of everything will be <> to &quot;MSys&quot;


MichaelRed
redmsp@erols.com

There is never time to do it right but there is always time to do it over

 

[scking]

Worst case, at least here, is that it would have documented the system tables in text and the user could remove them. I did warn that it was an earlier version than expected. I discovered while running this code in Access 2002 that the 'Description' property no longer exists and the code fails. Since this code is not required to create the scripts but only added comments it should be removed. I'm not sure whether the property is in Access 2000.

Steve King Growth follows a healthy professional curiosity