[Excel VBA] CopyFromRecordset

Descrizione :
Semplice tecnica VBA per importare velocemente dati da un DB Access in un Foglio Excel.

+ Articolo :

Il Metodo CopyFromRecordset è disponiblie a partire da Excel 2003.

Di seguito mostro 3 varianti per file Access .mdb : le prime due usano CopyFromRecordset, mentre l'ultima un Loop diretto sul Recordset ottenuto.

N.B.: E' necessario aggiungere nell'Editor VBA ( menu Strumenti / Riferimenti ), se già non presente nel Progetto VBA corrente, un Riferimento alla libreria :
Microsoft DAO 3.6 Object Library
Nel caso di questo esempio ( Excel + Access 2003 ), la versione è la 3.6.

Nell'esempio il DB Access è nella stessa cartella del file Excel.

--> Variante 1 :
E' il sistema più immediato. Il Recordset viene caricato direttamente da una Tabella o Stored Query di Access :

    Dim percorso As String 'Percorso File DB
    percorso = ThisWorkbook.Path & "\"
 
    Dim nomeDb As String 'Nome File DB
    nomeDb = "nomeDB.mdb"
 
    Dim nomeTabQry As String 'Nome Tabella o Stored Query Access
    nomeTabQry = "nomeTabella"
 
    Dim DB As Database
    Dim RS As Recordset
    Set DB = OpenDatabase(percorso & nomeDb)
    Set RS = DB.OpenRecordset(nomeTabQry)
 
    'Intestazione Colonne
    Dim i As Integer
    For i = 0 To RS.Fields.Count - 1
        ThisWorkbook.Worksheets("Foglio1").Cells(1, i + 1).FormulaR1C1 = RS.Fields(i).Name
    Next i
 
    'Tabella Dati
    ThisWorkbook.Worksheets("Foglio1").Range("A2").CopyFromRecordset RS
 
    Set RS = Nothing
    DB.Close
    Set DB = Nothing

--> Variante 2 :
Il Recordset viene caricato con una Query definita come stringa in Excel :

    Dim percorso As String 'Percorso File DB
    percorso = ThisWorkbook.Path & "\"
 
    Dim nomeDb As String 'Nome File DB
    nomeDb = "nomeDB.mdb"
 
    Dim strSql As String 'Stringa Sql
    strSql = "SELECT * FROM nomeTabella"
 
    Dim DB As Database
    Dim RS As Recordset
    Set DB = OpenDatabase(percorso & nomeDb)
    Set RS = DB.OpenRecordset(strSql)
 
    'Intestazione Colonne
    Dim i As Integer
    For i = 0 To RS.Fields.Count - 1
        ThisWorkbook.Worksheets("Foglio1").Cells(1, i + 1).FormulaR1C1 = RS.Fields(i).Name
    Next i
 
    'Tabella Dati
    ThisWorkbook.Worksheets("Foglio1").Range("A2").CopyFromRecordset RS
 
    Set RS = Nothing
    DB.Close
    Set DB = Nothing

--> Variante 3 :
Voglio copiare le righe del Recordset intervallandole con righe vuote ( un esempio su come avere maggior controllo sul RS ottenuto ).
Non uso più CopyFromRecordset, ma un Loop :

    Dim percorso As String 'Percorso File DB
    percorso = ThisWorkbook.Path & "\"
 
    Dim nomeDb As String 'Nome File DB
    nomeDb = "nomeDB.mdb"
 
    Dim nomeTabQry As String 'Nome Tabella o Stored Query Access
    nomeTabQry = "nomeTabella"
 
    Dim DB As Database
    Dim RS As Recordset
    Set DB = OpenDatabase(percorso & nomeDb)
    Set RS = DB.OpenRecordset(nomeTabQry)
 
    'Intestazione Colonne
    Dim i As Integer
    For i = 0 To RS.Fields.Count - 1
        ThisWorkbook.Worksheets("Foglio1").Cells(1, i + 1).FormulaR1C1 = RS.Fields(i).Name
    Next i
 
    'Tabella Dati
    Dim r As Long
    r = 3
    If Not RS.BOF Then RS.MoveFirst
    While Not RS.EOF
        For i = 0 To RS.Fields.Count - 1
            ThisWorkbook.Worksheets("Foglio1").Cells(r, i + 1).FormulaR1C1 = RS.Fields(i).Value
        Next i
        RS.MoveNext
        r = r + 2
    Wend
 
    Set RS = Nothing
    DB.Close
    Set DB = Nothing

In presenza di file di database .accdb, meglio affidarsi ad ADODB ( che può essere valida alternativa anche per i casi precedenti ), quindi in questo caso andrà aggiunto un RIF. alla Libreria :
Microsoft ActiveX Data Objects 2.8 Library

--> Variante 1 ( con Access 2007 ) :

    Dim percorso As String 'Percorso File DB
    percorso = ThisWorkbook.Path & "\"
 
    Dim nomeDb As String 'Nome File DB
    nomeDb = "nomeDB.accdb"
 
    Dim nomeTabQry As String 'Nome Tabella o Stored Query Access
    nomeTabQry = "nomeTabella"
 
    Dim CN As ADODB.Connection
    Dim RS As ADODB.Recordset
    Set CN = New ADODB.Connection
    CN.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                           percorso & nomeDb & ";Persist Security Info=False;"
    CN.Open
    Set RS = New ADODB.Recordset
    RS.Open nomeTabQry, CN, adOpenKeyset, adLockReadOnly, adCmdTable
 
    'Intestazione Colonne
    Dim i As Integer
    For i = 0 To RS.Fields.Count - 1
        ThisWorkbook.Worksheets("Foglio1").Cells(1, i + 1).FormulaR1C1 = RS.Fields(i).Name
    Next i
 
    'Tabella Dati
    ThisWorkbook.Worksheets("Foglio1").Range("A2").CopyFromRecordset RS
 
    CN.Close
    Set CN = Nothing
    Set RS = Nothing

Varianti 2 e 3 per .accdb, analogamente ai casi visti per file .mdb.

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Posted in: Excel VBA