Archiwa tagu: Recordset

Lista kwerend do tabeli Access

Opublikowany przez
Odpowiedz

Ostatnio musiałem przeanalizować dość złożoną bazę Access z kilkuset kwerendami
Oto jak sobie zrobić ich spis do okienka debuggera lub do tabeli
Jeżeli chcemy wrzucać dane do tabeli musimy ją najpierw utworzyć (nazwa tabeli jak i nazwy pól muszą być identyczne jak w kodzie)
Jeżeli nie chcemy wrzucać do tabeli to trzeba usunąć wszystkie linijki gdzie jest odwołanie do obiektu Recordset (rs)
Oczywiście aby wrzucić dane do okienka Debuggera trzeba je po pierwsze włączyć (Ctrl+G) a po drugie odkomentować linijkę z Debug.Print

Option Compare Database
Option Explicit
 
Sub lista_kwerend_do_tabeli()
    Dim db As DAO.Database
    Dim kw As DAO.QueryDef
    Set db = CurrentDb
    Dim Licznik_kw As Long
    Dim Typ_kw As String
    Dim rs As DAO.Recordset
    Set rs = db.OpenRecordset("_tbSpisKwerend")
 
    For Each kw In db.QueryDefs
        Licznik_kw = Licznik_kw + 1
        Select Case kw.Type
            Case 0
                Typ_kw = "SELECT"
            Case 32
                Typ_kw = "DELETE"
            Case 48
                Typ_kw = "UPDATE"
            Case 64
                Typ_kw = "APPEND"
        End Select
        'Debug.Print Licznik_kw; kw.Name, Typ_kw, kw.Fields.Count
        rs.AddNew
        rs.Fields("Nazwa_kw").Value = kw.Name
        rs.Fields("Typ_kw").Value = Typ_kw
        rs.Fields("Liczba_pol").Value = kw.Fields.Count
        rs.Update
    Next
    Set db = Nothing
End Sub

ADO – i wszystkie bazy są nasze :)

Opublikowany przez
1

Od 2000 roku czyli już od ponad 20 lat Microsoft Office może bez problemu łączyć się w zasadzie z dowolnymi bazami danych, dzięki bibliotece ADO (Microsoft ActiveX Data Object XX Library). I od tych samych ponad 20 lat budzi to niezmiennie zdziwienie wśród moich klientów i studentów. Jak to? Excel może pobrać dane z Oracle?, SQL Servera? O! Może nawet je edytować?! No oczywiście, że może, i to od wielu lat…
Biblioteka ADO (w kodzie widoczna jako ADODB) jest domyślnie podłączana tylko w Accessie. We wszystkich innych produktach, w tym w Excelu trzeba ją wybrać w referencjach. Tools – References – Microsoft ActiveX Data Object XX Library, gdzie XX to numer wersji biblioteki, ja osobiście wybieram zwykle wersję 2.8
Drugi warunek to oczywiście poprawnie zainstalowany sterownik OLEDB do określonej bazy (http://en.wikipedia.org/wiki/OLE_DB_provider)

Poniżej przykład pobierający do Excela dane z Accessa 2003, ale uważny czytelnik zobaczy drogę pobierania z Accessa 2007/10/13/16/19 tudzież z SQL Servera. Wystarczy podmienić wartość właściwości ConnectionString obiektu Connection

Option Explicit
Public Const WERSJA As String = "ADO Klient v.0.1"
Public Const ARK_DANE As String = "Dane"
Public Const ZRODLO As String = "tbBrutto"
 
'Załozenia:
' - mamy arkusz o nazwie "Dane"
' - mamy bazę PodstawyVBA.mdb a w niej tabelę tbBrutto
' - mamy sterownik do mdb
 
'Access mdb
'==========
Public Const CN_STR As String = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=D:\kursy\AC04\PodstawyVBA.mdb;" & _
    "Persist Security Info=False"
 
 
'Ponizej przykłady konfiguracji dla innych baz
 
'Access accdb
'============
'Public Const CN_STR As String = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=D:\kursy\AC04\PodstawyVBA.accdb;" & _
    "Persist Security Info=False"
 
'SQL Server
'==========
'Public Const CN_STR As String = _
    "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
    "Persist Security Info=False;" & _
    "Initial Catalog=Produkcyjna;" & _
    "Data Source=SKARBEKMC\SQLEXPRESS"
 
 
Sub OdczytDoExcela()
    Dim Zakres As Range
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
 
    On Error GoTo Obsluga
 
    Sheets(ARK_DANE).Select
    Range("A1").Select
    Set Zakres = _
        Sheets(ARK_DANE).Range("A1").CurrentRegion
    Zakres.ClearContents
 
    cn.ConnectionString = CN_STR
    cn.Open
    rs.Open ZRODLO, cn
    Sheets(ARK_DANE).Range("A2").CopyFromRecordset rs
 
    'nagłówki
    Dim LK As Long, K As Long
    LK = rs.Fields.Count
    For K = 1 To LK
        Sheets(ARK_DANE).Cells(1, K) = rs.Fields(K - 1).Name
    Next
 
    Zakres.EntireColumn.AutoFit
 
Czyszczenie:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Exit Sub
Obsluga:
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, WERSJA
    Resume Czyszczenie
End Sub