Hallo zusammen
In einer Access-Tabelle gibt es als Bestandteil einer Column ein Feld „Beschreibung“. Dieses will ich mit VB6 auslesen. DAO bietet nichs. Hat jemand eine Idee oder Erfahrung damit?
Grüsse Peter 
Habe z.Zt. wenig Zeit
vieleicht helfen Dir die Prozeduren.
Falls Du nicht zurechtkommst melde Dich nochmal
Den tblNamen passe bitte an
viel Glück
Norbert Laas
----- Original Message -----
From: Norbert Laas
To: Norbert Laas
Sent: Wednesday, July 05, 2000 4:56 PM
Subject: doku von Tabellen
Option Compare Database
Option Explicit
Sub Test()
TableInfo („tblAdvertisers“)
End Sub
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, fldrequired 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“, „Required“, „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
fldrequired = tdf.Fields(I).Required
On Error Resume Next
flddes = „“
flddes = tdf.Fields(I).Properties(„Description“)
Err.Clear
On Error GoTo TableInfoErrPrint
Debug.Print fldnam & Str&(43)
Debug.Print fldtyp,
Debug.Print fldsiz,
Debug.Print fldrequired,
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
Danke - Teste es heute Nacht - grüsse Peter )
o.T.