Access Datenbankanalyse Feldname, Beschreibung etc.

Const connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\DB1.mdb;Persist Security Info=False;"  
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3

Set objConnection = CreateObject("ADODB.Connection")  
Set objRecordset = CreateObject("ADODB.Recordset")  
Set objCat =CreateObject("ADOX.Catalog")  

' Datenbank öffnen  
objConnection.Open connectString	
Set objCat.ActiveConnection = objConnection
lngTabCount = objCat.Tables.Count          
'msgbox "Anz. Tabellen: " & lngTabCount	   

Set objExcel = CreateObject("Excel.Application")	' Excel Starten  
Set objWorkbook = objExcel.Workbooks.Add			' Neue Arbeitsmappe  
Set objWorkSheet = objWorkbook.Worksheets(1)		' Neue Tabelle  
objWorkSheet.Range("A1").Value = "Tabellenname"    
objWorkSheet.Range("B1").Value = "Feldname"    
objWorkSheet.Range("C1").Value = "Felddatentyp"    
objWorkSheet.Range("D1").Value = "Feldgrösse"    
y = 1 
For i = 0 to lngTabCount -1
	AktTab = objCat.Tables(i).Name
	msgbox "Tabelle: " & AktTab  
	lngColCount = objCat.Tables(AktTab).Columns.Count
	For x = 0 to lngColCount -1
		y = y + 1
		AktCol = objCat.Tables(AktTab).Columns(x).Name
		AktType = objCat.Tables(AktTab).Columns(x).Type 
		Select Case AktType
		Case 3
			AktTypeText = "Zahl"  
		case 202
			AktTypeText = "Text"  
		case 7
			AktTypeText = "Datum/Uhrzeit"  
		case 205
			AktTypeText = "OLE-Objekt"			  
		case else
		end select
		AktSize = objCat.Tables(AktTab).Columns(x).DefinedSize 
		objWorkSheet.Range("A" & y).Value = AktTab  
		objWorkSheet.Range("B" & y).Value = AktCol  
		if AktTypeText<>"" Then  
			objWorkSheet.Range("C" & y).Value = AktTypeText  
		else
			objWorkSheet.Range("C" & y).Value = "Typenumber: " & AktType  
		end if
		objWorkSheet.Range("D" & y).Value = AktSize  
		AktTypeText=""  
	next 
next 
objWorkbook.SaveAs "C:\TabellenStruktur.xls"  
objExcel.Visible = True