Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 63962 Skopiuj do schowka Zapis pobranych danych bezpośrednio do tablicy
Autor Wiadomość
cool_aikon
Fan Excela


Posty: 90
Wysłany: 28-01-2019, 11:56   Zapis pobranych danych bezpośrednio do tablicy

Mam taki problem. Chcę aby pobrane dane z Accessa od razu były zapisane w tablicy a nie najpierw do arkusza i dopiero stamtąd pobieram dane do tablicy. Moje makro obecnie wygląda następująco:
Kod:

Sub DaneDoTablicy()

        'Pobranie danych z bazy
        Dim cn As Object, rs As Object
        On Error GoTo UserForm_Initialize_Err
        Dim DBFullName As String
        Dim Szukaj As String
        Dim TabDane As Variant 'Deklaracja tablicy
   
        DBFullName = ThisWorkbook.Path & "\BAZA.accdb"
       
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & DBFullName & ";"
       
        'zapytanie sprawdzamy czy istnieje materiał
        Set rs = CreateObject("ADODB.Recordset")
        ZapSQL = "SELECT *"
        ZapSQL = ZapSQL & " FROM Materialy"
        rs.Open ZapSQL, cn, 3, 3
       
        'Sprawdzamy czy są rekordy
        With rs
            If Not .EOF() Then
             
                'Naglowki pobranych danych
                For intColIndex = 0 To rs.Fields.Count - 1
                    Sheets("TMP").Cells(1, 1).Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
                Next
               
                'Miejsce gdzie maja być wyświetlone dane
                Sheets("TMP").Cells(1, 1).Offset(1, 0).CopyFromRecordset rs
                TabDane = Range(Sheets("TMP").Cells(1, 1), Sheets("TMP").Cells(5, 4))
                   
            Else
                MsgBox "Nie znaleziono rekordów.", vbOKOnly + vbExclamation, "Komunikat"
            End If
        End With
           
        Debug.Print TabDane(1, 1)
        Debug.Print TabDane(1, 2)
        Debug.Print TabDane(1, 3)
        Debug.Print TabDane(1, 4)
       
UserForm_Initialize_Exit:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Exit Sub
   
UserForm_Initialize_Err:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
    End Select
    Resume UserForm_Initialize_Exit
   
End Sub
ID posta: 361447 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 193 razy
Posty: 881
Wysłany: 28-01-2019, 15:57   

cool_aikon napisał/a:
od razu były zapisane w tablicy

Zastosuj przypisanie 'GetRows' do zmiennej:
Kod:
TabDane = rs.GetRows

Tylko musisz pamiętać, że zamianie miejscami ulegają kolumny z wierszami.
('TabDane' zadeklarowana na poziomie modułu, a więc dostępna pomiędzy podprocedurami)
Kod:
Option Explicit

Private TabDane

Sub DaneDoTablicy_1()
    Const dbName As String = "BAZA.accdb"
    Const ZapSQL As String = "SELECT * FROM Materialy"
   
    Dim DBFullName As String, cnstr As String
    Dim cn As Object, rs As Object
   
    DBFullName = ThisWorkbook.Path & "\" & dbName
    cnstr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFullName & ";"
   
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
   
    cn.Open cnstr
    rs.Open ZapSQL, cn, 3, 3
   
    On Error Resume Next
        TabDane = rs.GetRows 'Układ danych w zmiennej TabDane = (kolumny, wiersze)
    On Error GoTo 0
   
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
   
    If Not IsArray(TabDane) Then
        MsgBox "Nie znaleziono rekordów ... Guinnessa ... :-> ...", vbOKOnly + vbExclamation, "Komunikat"
        Exit Sub
    End If
   
    '... Dalsze polecenia
End Sub
ID posta: 361464 Skopiuj do schowka
 
 
cool_aikon
Fan Excela


Posty: 90
Wysłany: 28-01-2019, 17:58   

Dzięki za pomoc :) o to właśnie mi chodziło :)
ID posta: 361469 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe