Skapa tabeller och fält i databaser


Detta tips är en utvecklad version av tipset Skapa temporära databaser och visar på ytterligare möjligheter vi har genom de externa biblioteken ADO och ADOX.


I exemplet används Early Binding varför referenser måste anges till följande externa bibliotek:

  1. Microsoft ActiveX Data Objects 2.5 Library och senare version
  2. Microsoft ADO Ext. 2.5 for DLL and Security och senare version.

 

Följande bild visar exempelunderlaget för att skapa tabeller och deras fält:

 

 

Om ett felmeddelande erhålls vid kopiering till VBA-modul så läs mer här»
 

 

(© 2002 - 2005 All rights Colo - Used by permission)

Option Explicit  

Const stDB As String = "c:\XLDennis.mdb"

Const stCon As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _

                                    "Data Source=" & stDB & ";"  

Sub Skapa_Tabeller_Falt()

  '© 2005 Alla rättigheter XL-Dennis

  Dim xCat As ADOX.Catalog

  Dim xTable As ADOX.Table

 

  Dim wsSheet As Worksheet

  Dim cTables As Collection

  Dim vaValues As Variant

  Dim lnRows As Long

  Dim i As Long, j As Long, k As Long

 

  With ActiveWorkbook

    Set wsSheet = .Worksheets(1)

  End With

 

  With wsSheet

    lnRows = .Range("C65536").End(xlUp).Row

    'Hämtar tabell- och fältuppgifterna från arbetsbladet.

    vaValues = .Range("A2:E" & lnRows).Value

  End With

 

  'Instansiera ADOX-objektet.

  Set xCat = New ADOX.Catalog

  'Instaniera Collection-objektet.

  Set cTables = New Collection

 

  'Då vi använder en befintlig databas så ansluter vi till den.

  xCat.ActiveConnection = stCon

 

  'Skapar listan med unika tabellnamn.

  On Error Resume Next

  For i = 1 To UBound(vaValues)

    cTables.Add vaValues(i, 1), CStr(vaValues(i, 1))

  Next i

  On Error Resume Next

 

  'Iterera genom listan med unika tabellnamn, skapar dessa och lägger

  'till dem till databasen.

  For k = 1 To cTables.Count

    Set xTable = New ADOX.Table

    With xTable

      'Namnge tabell.

      .Name = "tbl_" & cTables(k)

      'Skapa fältet som utgör primärnyckeln för tabellen.

      .Columns.Append "ID", adInteger

      'För att få tillgång till vissa av tabellers egenskaper måste

      'vi ange ParentCatalog.

      .ParentCatalog = xCat

      .Columns("ID").Properties("AutoIncrement").Value = True

      'Tilldelar primärnyckeln till det skapade fältet.

      .Keys.Append "PrimaryKey", adKeyPrimary, "ID"

      'Iterera genom variant arrayen med fältnamn och några centrala egenskaper

      'och tilldelar fälten till den aktuella tabellen.

      For j = 1 To UBound(vaValues)

        If vaValues(j, 1) = cTables(k) Then

          If vaValues(j, 3) = "Integer" Then

            .Columns.Append vaValues(j, 2), adInteger

          ElseIf vaValues(j, 3) = "Decimal" Then

            .Columns.Append vaValues(j, 2), adNumeric

            .Columns(vaValues(j, 2)).Precision = CLng(vaValues(j, 5))

          ElseIf vaValues(j, 3) = "Date" Then

            'Kortdatum kan inte läggas in via kod och därför bör datumformatering

            'ske när datumdata visas i ett gränssnitt.

            .Columns.Append vaValues(j, 2), adDate

          Else 'Textfält

            .Columns.Append vaValues(j, 2), adWChar, CLng(10)

          End If

        End If

      Next j

      'Vill vi fullständigt dölja tabellen vid öppnandet av databasen i MS Access

      'kan vi använda oss av följande egenskap, vilket endast kan ske när tabell

      'skapas.

      '.Properties("Jet OLEDB:Table Hidden in Access").Value = True

    End With

    'Tilldelar den skapade tabellen till databasen.

    xCat.Tables.Append xTable

    Set xTable = Nothing

  Next k

 

  MsgBox "Databasen har framgångsrikt blivit uppdaterad!"

 

  'Frigör objekt från minnet.

  Set cTables = Nothing

  Set xTable = Nothing: Set xCat = Nothing

End Sub