Importera filtrerad statisk
data från Access

Här demonstreras hur vi automatiskt kan hämta filtrerad data från en tabell i en databas till ett arbetsblad.

I exemplet används ADO (ActiveX Data Objects) för import av data till XL.

Saknas ADO-biblioteket på din dator kan den hämtas från Microsofts databashemsida. Det kan vara aktuellt för dig som använder XL 97 med ett äldre operativsystem än Windows 2000.

Innan proceduren körs måste en referens sättas till ADO:s bibliotek:
Det sker på följande sätt:

1. Öppna VB-Editorn i Excel.

2. Välj kommandot Verktyg | Referenser...

3. Kryssa för Microsoft ActiveX Data Objects x.x Library

 

En enkel databas ligger till grund för exemplet och består endast av en tabell - tblNamn.

Tabellen har följande fältnamn: Räknare, Namn, Avdelning och Lön.

I exemplet används en kombinationsruta (combobox) i det berörda arbetsbladet för att underlätta valen. Texten för de olika valen i denna procedur (se nedan) följer huvudprocedurens struktur och förklarar därmed de olika SELECT-satserna.

Procedurerna får kopieras manuellt till en arbetsbok.

Följande procedur placeras i modulen ThisWorkbook / DennaArbetsbok:

Option Explicit   Private Sub Workbook_Open()    '© 2003 Alla rättigheter XL-Dennis    Worksheets("Blad1").Shapes("cmbFilter").ControlFormat.List = _          Array( _          "Alla fält och alla poster där Lön >= 17.000 kr", _          "Poster där Lön > = 16.000 kr och Avdelning BB", _          "Poster där Lön > = 16.000 kr och Avdelning VV", _          "Poster där Lön >= 16.000 kr eller Avdelning BB", _          "Namn och Lön och där Lön >= 16.000 kr och Avdelning BB", _          "Unika värden Lön", _          "Alla fält Avdelning AA och BB", _          "Alla fält Avdelning AA och BB med Lön >=18.000 Kr", _          "Namn som börjar på D eller Lön <= 20.000 Kr - Namnsorterad stigande", _          "Namn som börjar på D eller Lön <= 20.000 Kr - Namsorterad fallande", _          "Alla fält och endast Löneintervall 17 - 19.000 Kr", _          "Alla fält och utan Löner i intervallet 17 - 19.000 Kr") End Sub

 

Följande procedur placeras i en standardmodul:

Option Explicit   Sub Importera_FiltreradData_Access1()    '© 2003 Alla rättigheter XL-Dennis    Dim cnt As ADODB.Connection    Dim rst As ADODB.Recordset    Dim stDB As String    Dim lnAntalFalt As Long, lnAntal As Long, lnVal As Integer      Set cnt = New ADODB.Connection    Set rst = New ADODB.Recordset      stDB = ThisWorkbook.Path & "\" & "XLData.mdb"      'Ta bort tidigare hämtade uppgifter    Range("A1").CurrentRegion.Clear      'Här läses det valda Indexvärdet in    With Shapes("cmbFilter").ControlFormat       If .ListIndex <> 0 Then          lnVal = .ListIndex       Else          Exit Sub       End If    End With      'Här skapas databasanslutningen    cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _          "Data Source=" & stDB & ";"      'Filtrering sker med SQL och Select Case styr urvalet.    Select Case lnVal    Case 1       rst.Open "SELECT * FROM tblNamn WHERE [Lön] >=17000", cnt    Case 2       rst.Open "SELECT * FROM tblNamn WHERE [Lön]>=16000 AND [Avdelning]='BB'", cnt    Case 3       rst.Open "SELECT * FROM tblNamn WHERE [Lön]>=16000 AND [Avdelning] LIKE 'VV'", cnt    Case 4       rst.Open "SELECT * FROM tblNamn WHERE [Lön]>=16000 OR [Avdelning]='BB'", cnt    Case 5     'Denna sats ska vara på en rad:       rst.Open "SELECT [Namn], [Lön] FROM tblNamn WHERE [Lön]>=16000 AND [Avdelning]  _                      LIKE 'BB'", cnt    Case 6       rst.Open "SELECT DISTINCT [Lön] FROM tblNamn", cnt    Case 7       rst.Open "SELECT * FROM tblNamn WHERE [Avdelning] IN ('AA', 'BB')", cnt    Case 8       rst.Open "SELECT * FROM tblNamn WHERE [Avdelning] IN ('AA', 'BB') AND [Lön]>=18000", cnt    Case 9       rst.Open "SELECT [Namn], [Lön] FROM tblNamn WHERE [Namn] LIKE 'D' OR [Lön]<=20000", cnt    Case 10    'Denna sats ska vara på en rad:       rst.Open "SELECT [Namn], [Lön] FROM tblNamn WHERE [Namn] LIKE 'D' OR [Lön]<=20000  _                     ORDER BY [Namn] DESC", cnt    Case 11       rst.Open "SELECT * FROM tblNamn WHERE [Lön] BETWEEN 17000 AND 19000", cnt    Case 12       rst.Open "SELECT * FROM tblNamn WHERE [Lön] NOT BETWEEN 17000 AND 19000", cnt    End Select      'Här överförs respektive fältnamn från tabellen tblNAmn.    lnAntalFalt = rst.Fields.Count    For lnAntal = 0 To lnAntalFalt - 1       Cells(1, lnAntal + 1).Value = rst.Fields(lnAntal).Name    Next lnAntal      'Här kopieras data till arbetsbladet.    Cells(2, 1).CopyFromRecordset rst      'Kopplar ned anslutningen och tömmer arbetsminnet.    rst.Close    Set rst = Nothing    cnt.Close    Set cnt = Nothing End Sub