ADO – Connexion à un fichier Excel


Sub adoReference()
'Microsoft Scripting Runtime activé
'Microsoft ActiveX DataObjects 6.1 Library activé

Application.ScreenUpdating = False

Sheets("Test").Cells.ClearContents

Dim aa As Variant

Dim myPath As String
myPath = ThisWorkbook.Path

Dim myFile As String
myFile = "ref.xlsx"

Dim tabName As String
'tabName = "Sheet1"
tabName = "info"
'tabName = "info2"'cas de figure sans résultat dans le recordset (bdd vide)

'connexion
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection

'recordset
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

    
'connection au fichier source
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source = " & myPath & "\" & myFile & ";Extended Properties='Excel 12.0;HDR=yes'"

'On place le curseur côté client, cela permet de compter le nombre de lignes dans le recordset
'(si le curseur reste côté serveur, il renvoie la valeur -1)
rs.CursorLocation = adUseClient


'requête
Dim mQuery As String
myQuery = "SELECT *  FROM [" & tabName & "$A1:IV65536] " 'si le nom de la table (ici variable tabName) n'est pas précisé, il prend en compte le 1er onglet

'l'enregistrement de la requête dans le rs s'effectue normalement de la façon suivante :
'Set rs = cnn.Execute("SELECT * FROM [" & tabName & "$A1:IV65536] ")

'mais Set rs = cnn.Execute ne permet pas de compter le nombre de lignes dans le recordset, donc ici, on utilise rs.open
rs.Open myQuery, cnn

'enregistre le nombre de lignes enregistrées dan le rs
Dim sqlRowsCount As Integer
sqlRowsCount = rs.RecordCount



'Definit la celllule à partir de laquelle recopier l'info dans l'onglet
Dim myRange As Range
Set myRange = Sheets("Test").Range("A" & Rows.Count).End(xlUp).Offset(1)

'vérifie qu'il existe bien des résultats à la requête
If sqlRowsCount = 0 Then

    myRange.Value = "Pas de résultat"
Else

    'recopie les en-têtes
    Dim i As Integer
    For i = 0 To rs.Fields.Count - 1
       Cells(1, i + 1).Value = rs.Fields(i).Name
    Next i

    'Copie les résultats de la requête directement sur la feuille de calcull
    'myRange.CopyFromRecordset rs
    
    'enregistre les résultats dans une variable aa
    aa = rs.GetRows
    
    'convertit la date en numero de série pour éviter que la transposition n'inverse le mois et la date
    For i = LBound(aa, 2) To UBound(aa, 2)
    aa(0, i) = CLng(aa(0, i))
    Next i
    
    'affichage
    myRange.Resize(UBound(aa, 2) + 1, UBound(aa) + 1) = Application.Transpose(aa)
    'formatage de la colonne de date
    Columns("A:A").NumberFormat = "dd/mm/yyyy"
End If


rs.Close
cnn.Close

Application.ScreenUpdating = True

End Sub

Fichiers :
ref
main

Votre commentaire

Entrez vos coordonnées ci-dessous ou cliquez sur une icône pour vous connecter:

Logo WordPress.com

Vous commentez à l’aide de votre compte WordPress.com. Déconnexion /  Changer )

Photo Google

Vous commentez à l’aide de votre compte Google. Déconnexion /  Changer )

Image Twitter

Vous commentez à l’aide de votre compte Twitter. Déconnexion /  Changer )

Photo Facebook

Vous commentez à l’aide de votre compte Facebook. Déconnexion /  Changer )

Connexion à %s