Skapa temporär databas


Det är vanligt att användare i större företag inte har programvaran MS Access tillgänglig och att man därför kan uppfatta att man inte kan skapa databaser.

Windows m fl andra program levereras med databasmotorn Microsoft Jet Engine och denna gör det möjligt att skapa mdb-filer (mdb = Microsoft Database).

Generellt tycker XL-Dennis att Excel inte ska användas som ett lagringsprogram utan i första hand för bearbetning, beräkning och sammanställning av data.


I detta tips visas hur vi kan skapa en temporär databas för lagring av data från en textfil.

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.

 

Ett närliggande tips är Skapa tabeller och fält i databaser.

 

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 stPath As String = "c:\DDE\"

Const stDBase As String = "Source.mdb"

 

'För att skapa en mdb i Access 97 formatet läggs följande sträng till

'anslutningssträngen: "Jet OLEDB:Engine Type=4;"

'"Standardformatet är Access 2000(Type=5).

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

                                    "Data Source=" & stPath & stDBase & ";"

 

'SQL-frågan för dataimport till mdb.

Const stSQLAdd As String = "INSERT INTO tblReportData " & _

                                         "SELECT * " & _

                                         "FROM [Text;DATABASE=" & stPath & "].[Data.txt];"

 
'SQL-frågan för dataimport till Excel.

Const stSQLSelect As String = "SELECT Dept, Quarter, SUM(Amount) " & _

                                            "FROM tblReportData " & _

                                            "GROUP BY Dept, Quarter;"

 

Sub Skapa_Temporär_MDB()

  '© 2005 Alla rättigheter XL-Dennis

  Dim xCat As ADOX.Catalog, xTable As ADOX.Table, xCol As ADOX.Column

  Dim cnt As ADODB.Connection, rst As ADODB.Recordset

  Dim wsSheet As Worksheet

 

  'Ta bort den eventuellt existerande databasen.

  On Error Resume Next

  Kill stPath & stDBase

  On Error GoTo 0

 

  'Instantiera objekten.

  Set wsSheet = ActiveSheet

  Set xCat = New ADOX.Catalog

  Set xTable = New ADOX.Table

 

  'Skapa den nya databasen,

  xCat.Create stCon

 

  'Addera kolumner till tabellen och ställ in så att dessa accepterar null-värden.

  With xTable

    'Namnge tabellen.

    .Name = "tblReportData"

    .Columns.Append "Dept"

    .Columns.Append "Quarter"

    .Columns.Append "Amount", adInteger

    'Ger access till de OLE DB Provider specifika egenskaperna.

    .ParentCatalog = xCat

    For Each xCol In .Columns

      .Columns(xCol.Name).Properties("Nullable").Value = True

    Next xCol

  End With

 

  'Lägger till tabellen till databasen.

  xCat.Tables.Append xTable

 

  'Det intressanta här är att se samtliga parametrar för anslutningen.

  Debug.Print xCat.ActiveConnection

 

  Set cnt = xCat.ActiveConnection

 

  With cnt

    'Dataimport till databasen från textfilen.

    .Execute (stSQLAdd)

    'Erhålla Recordset från databasen.

    Set rst = .Execute(stSQLSelect)

  End With

 

  If Not rst.BOF Or rst.EOF Then

    Application.ScreenUpdating = False

    'Lägger till fältnamn och skriver Recordset till arbetsbladet.

    With wsSheet

      With .Range("A1:C1")

        .Value = VBA.Array("Dept", "Quarter", "Total amount")

        .Font.Bold = True

        .EntireColumn.AutoFit

      End With

      .Range("A2").CopyFromRecordset rst

    End With

    Application.ScreenUpdating = True

  End If

 

  'Frigör objekt från minnet.

  Set rst = Nothing: Set cnt = Nothing

  Set xCol = Nothing: Set xTable = Nothing: Set xCat = Nothing

 

End Sub