structuur van tabellen inlezen in een mastertabel

Status
Niet open voor verdere reacties.

Benmdf

Gebruiker
Lid geworden
16 mrt 2013
Berichten
28
Hallo Iedereen,
Ben een paar weken geleden begonnen met Access,
Vroeger in delphi, heb ik een onderhoudsprogramma geschreven, dat de structuur van alle paradox tabellen op mijn computer inleest en in een daarvoor ontworpen tabellen wegschrijft
Zo kon ik bij db problemen, gemakkelijk deze db automatisch terug aanmaken
Ben al verschillende uren aan het zoeken maar vind de juiste methode niet
De bedoeling is dus dat ik van de access db's die ik nu reeds gemaakt heb het volgende inlees
en in een tabel opsla
1. Databasenaam bv Adressen
2 Tabelnaam Adres
3 veldnaam Naam
4 typeveld text
5 lengte 50
en zo dus voor ieder veld in iedere tabel
Als ik dit al kan in 1 tabel zal ik ze naderhand wel normliseren

Wie kan mij op het juiste pad zetten?
 
Je kunt Documentatie maken van de db. Heb je alles in een rapportje staan.
 
Bedankt Michel

bedankt voor je snelle reactie Michel

als ik er een rapport van maak , kan ik de gegevens heel waarschijnlijk niet importeren in een tabel
heb iets gezien zoals Fields collection,er was een routinnetje om in alle tabellen(+100) in een db een veldnaam te wijzigen die in elke tabel voorkomt, maar hoe kan ik alle gegevens importeren
Als jij het nog niet weet zal ik je miijn routinne laten geworden als ik het gefikst heb oke
 
Je kunt met een procedure de gegevens wel uitlezen en in een tabel zetten. Als je zelf al een idee hebt, zou ik zeggen: post hem, dan kunnen we daar mee verder.
 
Ik heb een drietal functies gemaakt die bestaande tabellen uitlezen, en de veldgegevens inlezen in een nieuwe tabel.
De eerste functie roept de rest aan, en is dus de hoofdfunctie. Hij verwijdert eerst de oude tabel Tabellen, en maakt hem dan opnieuw aan met de jusite velden. Mocht je de tabel willen aanpassen, dan kan je dat waarschijnlijk wel zelf. In het tweede deel van de functie worden alle bestaande tabellen uitgelezen, en de gegevens toegevoegd aan de Tabellen tabel.
Code:
Public Function AllTables()
Dim obj As AccessObject, dbs As Object
Dim cmd As New ADODB.Command
Dim strSQL As String
Dim collFields() As Variant
    
    On Error Resume Next
    CurrentDb.Execute "DROP TABLE Tabellen"
    On Error GoTo 0
    
    strSQL = "CREATE TABLE Tabellen " _
        & "(TabelID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, " _
        & "TabelNaam TEXT(50) WITH COMP NOT NULL, " _
        & "VeldNaam TEXT(50) WITH COMP NOT NULL, " _
        & "VeldTypeNaam TEXT(50) WITH COMP NOT NULL, " _
        & "VeldType LONG, VeldLengte LONG, " _
        & "Notes MEMO, " _
        & "CONSTRAINT TabelVeld UNIQUE (TabelNaam, VeldNaam));"
    With cmd
        .ActiveConnection = CurrentProject.AccessConnection
        .CommandText = strSQL
        .Execute
    End With
    
    Set dbs = Application.CurrentData
    ' Search for AccessObject objects in AllTables collection.
    For Each obj In dbs.AllTables
        If Not Left(obj.Name, 4) = "MSys" Then
            If IsOpen(obj.Name, acTable) Then DoCmd.Close acTable, obj.Name, acSaveYes
            ADO_FieldType (obj.Name)
        End If
    Next obj

End Function
De tweede functie kan een stuk korter als je niet de omschrijving van de veldtypes nodig hebt. Omdat de eigenschap Type wèl de property namen kent, maar getallen teruggeeft, wordt de naam eerst aan een variabele toegekend, die dan in de tabel wordt opgeslagen, samen met de waarde.
Code:
Function ADO_FieldType(Table As String)
Dim rst As New ADODB.Recordset, rstInvoer As New ADODB.Recordset
Dim fld As ADODB.Field
Dim FieldType As String, FieldTypeName As String
Dim strSQL As String, strInvoer As String, sH1 As String, sH2 As String
    
    With rstInvoer
        .ActiveConnection = CurrentProject.Connection
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Open "Tabellen"
        If InStr(1, Table, " ") > 0 Then sH1 = "[": sH2 = "]"
        strSQL = "SELECT * FROM " & sH1 & Table & sH2
        rst.Open strSQL, CurrentProject.Connection
        For Each fld In rst.Fields
            Select Case fld.Type
                Case adEmpty
                    FieldType = "adEmpty"
                Case adSmallInt
                    FieldType = "adSmallInt"
                Case adInteger
                    FieldType = "adInteger"
                Case adSingle
                    FieldType = "adSingle"
                Case adDouble
                    FieldType = "adDouble"
                Case adCurrency
                    FieldType = "adCurrency"
                Case adDate
                    FieldType = "adDate"
                Case adBSTR
                    FieldType = "adBSTR"
                Case adIDispatch
                    FieldType = "adIDispatch"
                Case adError
                    FieldType = "adError"
                Case adBoolean
                    FieldType = "adBoolean"
                Case adVariant
                    FieldType = "adVariant"
                Case adIUnknown
                    FieldType = "adIUnknown"
                Case adDecimal
                    FieldType = "adDecimal"
                Case adTinyInt
                    FieldType = "adTinyInt"
                Case adUnsignedTinyInt
                    FieldType = "adUnsignedTinyInt"
                Case adUnsignedSmallInt
                    FieldType = "adUnsignedSmallInt"
                Case adUnsignedInt
                    FieldType = "adUnsignedInt"
                Case adBigInt
                    FieldType = "adBigInt"
                Case adUnsignedBigInt
                    FieldType = "adUnsignedBigInt"
                Case adFileTime
                    FieldType = "adFileTime"
                Case adGUID
                    FieldType = "adGUID"
                Case adBinary
                    FieldType = "adBinary"
                Case adChar
                    FieldType = "adChar"
                Case adWChar
                    FieldType = "adWChar"
                Case adNumeric
                    FieldType = "adNumeric"
                Case adUserDefined
                    FieldType = "adUserDefined"
                Case adDBDate
                    FieldType = "adDBDate"
                Case adDBTime
                    FieldType = "adDBTime"
                Case adDBTimeStamp
                    FieldType = "adDBTimeStamp"
                Case adChapter
                    FieldType = "adChapter"
                Case adPropVariant
                    FieldType = "adPropVariant"
                Case adVarNumeric
                    FieldType = "adVarNumeric"
                Case adVarChar
                    FieldType = "adVarChar"
                Case adLongVarChar
                    FieldType = "adLongVarChar"
                Case adVarWChar
                    FieldType = "adVarWChar"
                Case adLongVarWChar
                    FieldType = "adLongVarWChar"
                Case adVarBinary
                    FieldType = "adVarBinary"
                Case adLongVarBinary
                    FieldType = "adLongVarBinary"
                Case AdArray
                    FieldType = "AdArray (Does not apply to ADOX.)"
                Case Else
                    FieldType = "Onbekend"
                    FieldType = fld.Type
            End Select
            .AddNew
            On Error Resume Next
            !Tabelnaam = Table
            !VeldNaam = fld.Name
            !VeldTypeNaam = FieldType
            !VeldType = fld.Type
            !VeldLengte = fld.DefinedSize
            .Update
        Next fld
    End With
    rst.Close
    rstInvoer.Close

End Function
De derde functie wordt gebruikt om een geopende tabel te sluiten. Dat is nodig, omdat je een geopende tabel niet kunt uitlezen.
Code:
Function IsOpen(strname As String, strtype As String) As Boolean
If SysCmd(acSysCmdGetObjectState, strtype, strname) <> 0 Then
    IsOpen = True
End If
End Function
 
Bedankt Michel

Hartelijk bedankt voor je toch wel supersnelle reactie
Dit ga ik zo snel mogelijk uitproberen
en hou je natuurlijk op de hoogte
 
Sorry Michel

Sorry Michel,
door dat ander dringend probleempje waar ik meezit
Vraag zojuist geformuleerd
kan ik dit pas nadien gaan testen
 
Status
Niet open voor verdere reacties.

Nieuwste berichten

Terug
Bovenaan Onderaan