Hallo Liste,
mein Problem ist ziemlich OT, ich wei�, aber weil's brennt wende ich mich an
Euch.
Habe aus einer Access 97 Datenbank ein Modul mit folgendem Inhalt
importiert.
Function TableInfo(strTableName As String)
' Alison Brown / ge�ndert: KObd
' Purpose: Print in the immediate window the field names, types, and
sizes for any table.
' Argument: name of a table in the current database.
Dim DB As DATABASE, tdf As TableDef, I As Integer
Dim fldnam As String, fldtyp As String, fldsiz As String, flddes As
String
Dim prp As Properties
Set DB = DBEngine(0)(0)
On Error GoTo TableInfoErr
Set tdf = DB.TableDefs(strTableName)
If Not AccessEigenschaftEinstellen(tdf, "Description", dbText, False)
Then
MsgBox "Adding Description Property to tables did not work"
Exit Function
End If
On Error GoTo TableInfoErrPrint
Debug.Print "FIELD NAME", "FIELD TYPE", "SIZE", "DESCRIPTION"
Debug.Print "==========", "==========", "====", "==========="
For I = 0 To tdf.Fields.count - 1
fldnam = tdf.Fields(I).Name
fldtyp = FieldType(tdf.Fields(I).Type)
fldsiz = tdf.Fields(I).Size
On Error Resume Next
flddes = ""
flddes = tdf.Fields(I).Properties("Description")
Err.Clear
On Error GoTo TableInfoErrPrint
Debug.Print fldnam,
Debug.Print fldtyp,
Debug.Print fldsiz,
Debug.Print flddes
' Debug.Print tdf.Fields(I).Name,
' Debug.Print FieldType(tdf.Fields(I).Type),
' Debug.Print tdf.Fields(I).Size,
' Debug.Print tdf.Fields(I).Properties("Description")
Next
Debug.Print "==========", "==========", "====", "==========";
TableInfoExit:
DB.Close
Exit Function
TableInfoErrPrint:
' Needed because a non existing Description within a field always causes an
Error
' and just a "Resume Next" would print the following fieldname within the
same line
If Err = 3270 Then
Debug.Print
Resume Next
Else
Debug.Print "Unerwarteter Fehler : " & Err
Resume Next
End If
TableInfoErr:
Select Case Err
Case 3265 ' Supplied table name invalid
MsgBox strTableName & " table doesn't exist"
Resume TableInfoExit
Case Else
Debug.Print "TableInfo() Error " & Err & ": " & Error
End Select
End Function
Function FieldType(N) As String
' Korrigierte Version
' Purpose: Converts the numeric results of DAO fieldtype to Text.
Select Case N
Case dbBoolean
FieldType = "Yes/No" '1
Case dbByte
FieldType = "Byte" '2
Case dbInteger
FieldType = "Integer" '3
Case dbLong
FieldType = "Long Integer" '4
Case dbCurrency
FieldType = "Currency" '5
Case dbSingle
FieldType = "Single" '6
Case dbDouble
FieldType = "Double" '7
Case dbDate
FieldType = "Date/Time" '8
Case dbText
FieldType = "Text" '10
Case dbLongBinary
FieldType = "OLE Object" '11
Case dbMemo
FieldType = "Memo" '12
Case Else
FieldType = "Unknown Type: " & N
End Select
End Function
Function AccessEigenschaftEinstellen(Obj As Object, strName As String, _
intTyp As Integer, varEinstellung As Variant) As Boolean
Dim prp As Property
Const conEigNichtGef As Integer = 3270
On Error GoTo FehlerAccessEigenschaftEinstellen
' Explizit auf die Auflistung "Properties" verweisen.
Obj.Properties(strName) = varEinstellung
Obj.Properties.Refresh
AccessEigenschaftEinstellen = True
BeendenAccessEigenschaftEinstellen:
Exit Function
FehlerAccessEigenschaftEinstellen:
If Err = conEigNichtGef Then
' Eigenschaft erstellen, Typ festlegen, Anfangswert einstellen.
Set prp = Obj.CreateProperty(strName, intTyp, varEinstellung)
' Eigenschaft-Objekt an die Auflistung "Properties" anf�gen.
Obj.Properties.Append prp
Obj.Properties.Refresh
AccessEigenschaftEinstellen = True
Resume BeendenAccessEigenschaftEinstellen
Else
MsgBox Err & ": " & vbCrLf & Err.Description
AccessEigenschaftEinstellen = False
Resume BeendenAccessEigenschaftEinstellen
End If
End Function
Leider will das in meiner Datenbank (Access 2000) nicht funktionieren, ich
kriege lauter Fehlermeldungen, das DB und tbf kein benutzerdefiniertes
Format w�ren oder das die Variable (N) leer w�re.
Kann mir mal jemand sagen, wie ich das hinkriege, das der Code auch in
Access 2000 funktioniert? Ich br�uchte es dringend, steh aber irgendwie auf
dem Schlauch und mein Chef sitzt mir im Nacken... :(
Gru�,
Arkor
| [aspdecoffeehouse] als [email protected] subscribed
| http://www.aspgerman.com/archiv/aspdecoffeehouse/ = Listenarchiv
| Sie k�nnen sich unter folgender URL an- und abmelden:
| http://www.aspgerman.com/aspgerman/listen/anmelden/aspdecoffeehouse.asp
