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, XLData1.mdb, ligger till grund för exemplet och består endast av en tabell - tblData.
Tabellen har följande fältnamn: Räknare, Nummer, Modell, In(Datum), Ut(Datum) Antal och Pris.Procedurerna får kopieras manuellt till en arbetsbok.
Option Explicit
Sub Importera_FiltreradData_Access3()
'© 2003 Alla rättigheter XL-Dennis
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stDB As String, stSQL As String
Dim lnAntalFalt As Long, lnAntal As Long
'Sökvägen till databasen.
stDB = ThisWorkbook.Path & "\" & "XlData1.mdb"
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
'Tar bort tidigare hämtade uppgifter i det aktiva arbetsbladet.
Cells(1, 1).CurrentRegion.Clear
'Här skapas anslutningen till databasen.
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & stDB & ";"
'Här sätts urvalet ihop till en SQL-sträng samt
'skapas ett beräknande fält - Summa.
stSQL = "SELECT [Nummer],[Modell],[Ut],[Antal] * [Pris]" _
& " AS Summa FROM tblData" _
& " WHERE [Antal] * [Pris] >= 5000" _
& " ORDER BY [Ut], [Modell];"
With rst
.CursorLocation = adUseClient
.Open stSQL, cnt, adOpenForwardOnly, adLockReadOnly
End With
lnAntalFalt = rst.Fields.Count
For lnAntal = 0 To lnAntalFalt - 1
Cells(1, lnAntal + 1).Value = rst.Fields(lnAntal).Name
Next lnAntal
'Här kontrolleras version av XL.
If Val(Application.Version) <= 8 Then
'För XL 97 eller tidigare
Dim vaData As Variant
Dim rnData As Range
Dim iPoster As Integer, iFalt As Integer
'Här läses alla poster in i en matris.
vaData = rst.GetRows()
'Här identifieras antal poster och fält.
iPoster = UBound(vaData, 2) + 1
iFalt = UBound(vaData, 1) + 1
'Här skrivs data in i det aktiva arbetsbladet mha
'av funktionen TRANSPONERA (se nedan) som ej har några
'begränsningar jämfört med den inbyggda TRANSPOSE-funktionen.
Set rnData = Range(Cells(2, 1), Cells(iPoster + 1, iFalt))
rnData = Transponera(vaData)
Else
'För Excel 2000 / 2002.
Cells(2, 1).CopyFromRecordset rst
End If
Range(Cells(2, 3), Cells(65536, 4).End(xlUp)).NumberFormat _
= "yyyy/mm/dd"
'Kopplar ned anslutningen och tömmer arbetsminnet.
rst.Close
Set rst = Nothing
cnt.Close
Set cnt = Nothing
End Sub
Function Transponera(vaData As Variant) As Variant
Dim i As Long, j As Long, x As Long, y As Long
Dim vaTemp As Variant
'Här tar vi reda på antal poster.
y = UBound(vaData, 1)
x = UBound(vaData, 2)
ReDim vaTemp(x, y)
'Här vänds matrisdatan från horisontell till vertikal.
For i = 0 To x
For j = 0 To y
vaTemp(i, j) = vaData(j, i)
Next j
Next i
'Här skrivs matrisdatan tillbaka.
Transponera = vaTemp
End Function