Option Explicit

Dim arrTables( ), i, idxTables, intValidArgs

Dim blnContent, blnFieldNames

Dim objConn, objFSO, objRS, objSchema

Dim strConnect, strHeader, strOutput

Dim strFile, strResult, strSQL, strTable

' ADODB Data Types

Const adEmpty                        =    0

Const adSmallInt                     =    2

Const adInteger                      =    3

Const adSingle                       =    4

Const adDouble                       =    5

Const adCurrency                     =    6

Const adDate                         =    7

Const adBSTR                         =    8

Const adIDispatch                    =    9

Const adError                        =   10

Const adBoolean                      =   11

Const adVariant                      =   12

Const adIUnknown                     =   13

Const adDecimal                      =   14

Const adTinyInt                      =   16

Const adUnsignedTinyInt              =   17

Const adUnsignedSmallInt             =   18

Const adUnsignedInt                  =   19

Const adBigInt                       =   20

Const adUnsignedBigInt               =   21

Const adFileTime                     =   64

Const adGUID                         =   72

Const adBinary                       =  128

Const adChar                         =  129

Const adWChar                        =  130

Const adNumeric                      =  131

Const adUserDefined                  =  132

Const adDBDate                       =  133

Const adDBTime                       =  134

Const adDBTimeStamp                  =  135

Const adChapter                      =  136

Const adPropVariant                  =  138

Const adVarNumeric                   =  139

Const adVarChar                      =  200

Const adLongVarChar                  =  201

Const adVarWChar                     =  202

Const adLongVarWChar                 =  203

Const adVarBinary                    =  204

Const adLongVarBinary                =  205

Const adArray                        = 8192

' ADODB Schema Types

Const adSchemaProviderSpecific       =   -1

Const adSchemaAsserts                =    0

Const adSchemaCatalogs               =    1

Const adSchemaCharacterSets          =    2

Const adSchemaCollations             =    3

Const adSchemaColumns                =    4

Const adSchemaCheckConstraints       =    5

Const adSchemaConstraintColumnUsage  =    6

Const adSchemaConstraintTableUsage   =    7

Const adSchemaKeyColumnUsage         =    8

Const adSchemaReferentialConstraints =    9

Const adSchemaTableConstraints       =   10

Const adSchemaColumnsDomainUsage     =   11

Const adSchemaIndexes                =   12

Const adSchemaColumnPrivileges       =   13

Const adSchemaTablePrivileges        =   14

Const adSchemaUsagePrivileges        =   15

Const adSchemaProcedures             =   16

Const adSchemaSchemata               =   17

Const adSchemaSQLLanguages           =   18

Const adSchemaStatistics             =   19

Const adSchemaTables                 =   20

Const adSchemaTranslations           =   21

Const adSchemaProviderTypes          =   22

Const adSchemaViews                  =   23

Const adSchemaViewColumnUsage        =   24

Const adSchemaViewTableUsage         =   25

Const adSchemaProcedureParameters    =   26

Const adSchemaForeignKeys            =   27

Const adSchemaPrimaryKeys            =   28

Const adSchemaProcedureColumns       =   29

Const adSchemaDBInfoKeywords         =   30

Const adSchemaDBInfoLiterals         =   31

Const adSchemaCubes                  =   32

Const adSchemaDimensions             =   33

Const adSchemaHierarchies            =   34

Const adSchemaLevels                 =   35

Const adSchemaMeasures               =   36

Const adSchemaProperties             =   37

Const adSchemaMembers                =   38

Const adSchemaTrustees               =   39

Const adSchemaFunctions              =   40

Const adSchemaActions                =   41

Const adSchemaCommands               =   42

Const adSchemaSets                   =   43

' Check command line arguments

With WScript.Arguments

	If .Unnamed.Count = 1 Then

		strFile = .Unnamed(0)

	Else

		Syntax

	End If

	blnFieldNames = True

	blnContent    = True

	If .Named.Count > 0 Then

		intValidArgs = 0

		If .Named.Exists( "T" ) Then

			blnFieldNames = False

			blnContent    = False

			intValidArgs  = intValidArgs + 1

		End If

		If .Named.Exists( "TF" ) Then

			blnContent    = False

			intValidArgs  = intValidArgs + 1

		End If

		If intValidArgs <> .Named.Count Then Syntax

	End If

End With

' Check if the specified database file exists

Set objFSO = CreateObject( "Scripting.FileSystemObject" )

If Not objFSO.FileExists( strFile ) Then Syntax

Set objFSO = Nothing

' Connect to the MS-Access database

Set objConn = CreateObject( "ADODB.Connection" )

strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile

objConn.Open strConnect

' Search for user tables and list them in an array

Set objSchema = objConn.OpenSchema( adSchemaTables )

idxTables = -1

Do While Not objSchema.EOF

	If objSchema.Fields.Item(3).Value = "TABLE" Then

		idxTables = idxTables + 1

		ReDim Preserve arrTables( idxTables )

		arrTables( idxTables ) = objSchema.Fields.Item(2).Value

	End If

	objSchema.MoveNext

Loop

' List all tables, their column names and their contents

For Each strTable In arrTables

	strSQL = "Select * From " & strTable

	Set objRS = objConn.Execute( strSQL )

	If IsObject( objRS ) Then

		' Display the current table's name

		If blnContent Then

			WScript.Echo """Table: " & strTable & """"

		Else

			WScript.Echo """" & strTable & """"

		End If

		If blnFieldNames Then

			strOutput = ""

			Do While Not objRS.EOF

	    		' Create a header line with the column names and data types

		    	strHeader = ""

	    		For i = 0 To objRS.Fields.Count - 1

    				strHeader = strHeader & ",""[" _

				              & GetDataTypeDesc( objRS.Fields.Item(i).Type ) & "] " _

					          & objRS.Fields.Item(i).Name & """"

			    Next

    			strHeader = Mid( strHeader, 2 )

	    		If blnContent Then

		    		' List the fields of the current record in comma delimited format

			    	strResult = ""

			    	For i = 0 To objRS.Fields.Count - 1

	    				strResult = strResult & ",""" & objRS.Fields.Item(i).Value & """"

    				Next

			    	' Add the current record to the output string

			    	strOutput = strOutput & Mid( strResult, 2 ) & vbCrLf

		    	End If

	    		' Next record

	    		objRS.MoveNext

			Loop

			' List the results for the current table

			WScript.Echo strHeader & vbCrLf & strOutput & vbCrLf

		End If

	End If

Next

objRS.Close

objSchema.Close

objConn.Close

Set objRS     = Nothing

Set objSchema = Nothing

Set objConn   = Nothing

Function GetDataTypeDesc( myTypeNum )

	Dim arrTypes( 8192 ), i

	For i = 0 To UBound( arrTypes )

		arrTypes( i ) = "????"

	Next

	arrTypes(0)     = "Empty"

	arrTypes(2)     = "SmallInt"

	arrTypes(3)     = "Integer"

	arrTypes(4)     = "Single"

	arrTypes(5)     = "Double"

	arrTypes(6)     = "Currency"

	arrTypes(7)     = "Date"

	arrTypes(8)     = "BSTR"

	arrTypes(9)     = "IDispatch"

	arrTypes(10)    = "Error"

	arrTypes(11)    = "Boolean"

	arrTypes(12)    = "Variant"

	arrTypes(13)    = "IUnknown"

	arrTypes(14)    = "Decimal"

	arrTypes(16)    = "TinyInt"

	arrTypes(17)    = "UnsignedTinyInt"

	arrTypes(18)    = "UnsignedSmallInt"

	arrTypes(19)    = "UnsignedInt"

	arrTypes(20)    = "BigInt"

	arrTypes(21)    = "UnsignedBigInt"

	arrTypes(64)    = "FileTime"

	arrTypes(72)    = "GUID"

	arrTypes(128)   = "Binary"

	arrTypes(129)   = "Char"

	arrTypes(130)   = "WChar"

	arrTypes(131)   = "Numeric"

	arrTypes(132)   = "UserDefined"

	arrTypes(133)   = "DBDate"

	arrTypes(134)   = "DBTime"

	arrTypes(135)   = "DBTimeStamp"

	arrTypes(136)   = "Chapter"

	arrTypes(138)   = "PropVariant"

	arrTypes(139)   = "VarNumeric"

	arrTypes(200)   = "VarChar"

	arrTypes(201)   = "LongVarChar"

	arrTypes(202)   = "VarWChar"

	arrTypes(203)   = "LongVarWChar"

	arrTypes(204)   = "VarBinary"

	arrTypes(205)   = "LongVarBinary"

	arrTypes(8192)  = "Array"

	GetDataTypeDesc = arrTypes( myTypeNum )

End Function

Sub Syntax

	Dim strMsg

	strMsg = strMsg & vbCrLf _

	       & "AccessRd.vbs,  Version 1.01" & vbCrLf _

	       & "Display MS Access database (user) tables and, optionally, their contents"  _

	       & vbCrLf & vbCrLf _

	       & "Usage:  CSCRIPT  //NOLOGO  ACCESSRD.VBS  access_db_file  [ /T | /TF ]" _

	       & vbCrLf & vbCrLf _

	       & "Where:  ""access_db_file""   is an MS-Access database file"   & vbCrLf _

	       & "        /T                 list table names only"             & vbCrLf _

	       & "        /TF                list table and field names only"   & vbCrLf _

	       & "                           (default is list tables, field names AND contents)" _

	       & vbCrLf & vbCrLf _

	       & "Written by Rob van der Woude" & vbCrLf _

	       & "http://www.robvanderwoude.com"

	WScript.Echo strMsg

	WScript.Quit(1)

End Sub