Disse websidene oppdateres ikke lengre og er kun tilgjengelig for historikken sin skyld.

Klikk her for å gå til den oppdaterte informasjonen.

Bruk en lukket arbeidsbok som database (ADO)

Prosedyrene nedenfor kan benyttes til å hente et ADO recordset fra en lukket arbeidsbok og lese/skrive data. Bruk prosedyren slik:
GetWorksheetData "C:\Foldername\Filename.xls", "SELECT * FROM [SheetName$];", ThisWorkbook.Worksheets(1).Range("A3")
Bytt ut SheetName med navnet på det regnearket du vil hente data fra.

Sub GetWorksheetData(strSourceFile As String, strSQL As String, TargetCell As Range)
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Integer, r As Long
    If TargetCell Is Nothing Then Exit Sub
    Set cn = New ADODB.Connection
    On Error Resume Next
    cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790; _
        ReadOnly=True;" & "DBQ=" & strSourceFile & ";"
    ' DriverId=790: Excel 97/2000
    ' DriverId=22:  Excel 5/95
    ' DriverId=278: Excel 4
    ' DriverId=534: Excel 3
    On Error GoTo 0
    If cn Is Nothing Then
        MsgBox "Finner ikke filen!", vbExclamation, ThisWorkbook.Name
        Exit Sub
    End If
        
    ' åpne et recordset
    Set rs = New ADODB.Recordset
    On Error Resume Next
    rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
'    rs.Open "SELECT * FROM [SheetName$]", cn, adOpenForwardOnly, _
        adLockReadOnly, adCmdText
'    rs.Open "SELECT * FROM [SheetName$]", cn, adOpenStatic, _
        adLockOptimistic, adCmdText
'    rs.Open "SELECT * FROM [SheetName$] WHERE [Field Name] LIKE 'A%'", _
        cn, adOpenStatic, adLockOptimistic, adCmdText
'    rs.Open "SELECT * FROM [SheetName$] WHERE [Field Name] LIKE 'A%' " & _
        "ORDER BY [Field Name]", cn, adOpenStatic, adLockOptimistic, adCmdText

'    alternative måter å åpne et recordset
'    Set rs = cn.Execute("[A1:Z1000]") ' det første regnarket
'    Set rs = cn.Execute("[DefinedRangeName]") ' hvilket som helst regneark
    
    On Error GoTo 0
    If rs Is Nothing Then
        MsgBox "Kan ikke åpne filen!", vbExclamation, ThisWorkbook.Name
        cn.Close
        Set cn = Nothing
        Exit Sub
    End If
    
    RS2WS rs, TargetCell
    ' TargetCell.CopyFromRecordset rs ' alternativ metode for Excel 2000 eller nyere
    
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Prosedyren RS2WS finner du ved å klikke på denne linken.

Eksempelmakroene forutsetter at ditt VBA-prosjekt har en referanse til ADO objektbiblioteket.
Dette gjøres i VBE ved ved å velge menyvalget Verktøy, Referanser og krysse av for Microsoft ActiveX Data Objects x.x Object Library.

Dokumentet er sist oppdatert 2001-11-11 22:16:42