XL 2010 Methode CopyFromRecorset a échoué

[Testysql]

Je vous souhaite de bonnes fêtes et merci d'avance si vous pouvez m'aider.

La macro ci-dessous reprend des données dans le tableau Excel (Feuil1) par une requête 'SELECT * FROM ' qui extrait les données en fonction d'un critère sur colonne5.

=> OK : en recherchant la valeur T1 c'est OK il affiche + 11 000 lignes 'T1'
=> NOK : en recherchant la valeur T2 ca bloque 'Methode CopyFromRecorset a échoué' à 2175 lignes et je n'arrive pas a trouver la source de l'erreur.

Sub TEST()

Dim TableauExcel As DAO.Database
Dim RS As DAO.Recordset

Req = "SELECT * " & _
"FROM BASE " & _
"WHERE BASE.[Colonne5] = '" & Range("E6") & "' "
Set TableauExcel = OpenDatabase(ThisWorkbook.FullName, False, False, "Excel 8.0")
Set RS = TableauExcel.OpenRecordset(Req)

Range("A10:BB10000").ClearContents

If RS.RecordCount <> 0 Then

For Champ = 1 To RS.Fields.Count
Cells(10, 0 + Champ) = RS.Fields(Champ - 1).Name
Next Champ

Range("A11").CopyFromRecordset RS
End If

End Sub

 

[patricktoulon]

bonjour
il faudra m'expliquer le pourquoi de l'utilisation d'un recordset sur le fichier lui même pour récupérer les lignes d'un tableau dans la [colonne5 ] correspondant à E6
un simple filtre ne suffirait il pas ?
et ton fichier est un xlsm (min 2007) alors excel 8.0 ça me parait un peu vieux ' comme version du moteur

 

[Hasco]

Bonjour,

J'ai créé une feuille nommée 'AdoDb' (copie de la feuille 'Résultat') puis ai fait la macro ci-dessous, qui fonctionne bien (3393 résultats)

Ligne importante :

rst.cursorlocation = 3 ' adUseClient

Sans cette ligne la macro a le même problème qu'avec la technique DAO. Un recordset DAO n'a pas de propriété CursorLocation.

A noter que Adodb sur un classeur ouvert interroge le classeur enregistré et non la copie temporaire qu' excel ouvre. Il est donc préférable d'enregistrer le classeur avant de lancer la macro si les données changent.

Mais @patricktoulon a raison, c'est sortir la grosse artillerie pour quelque chose qui pourrait être fait par filtrage avancé. On utilise la méthode adodb en général, pour des requêtes complexes.

N'oubliez pas non plus de nettoyer correctement vos variables objets en fin de macro.

Sub Test2()

    Dim DataTable As String, Req As String
    Dim cnx As Object, rst As Object

    With ThisWorkbook

        DataTable = "[Feuil1$" & .Sheets("Feuil1").Range("A1").CurrentRegion.Address(0, 0) & "]"

        Req = "SELECT * FROM " & DataTable & _
            " WHERE [Colonne5] = '" & .Sheets("AdoDb").Range("E6") & "';"

        Set cnx = CreateObject("Adodb.connection")

        cnx.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & .FullName & _
                              ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

        Set rst = CreateObject("adodb.recordset")
        cnx.Open
        rst.cursorlocation = 3 'adUseClient  !  IMPORTANT  !
        rst.Open Req, cnx

        With .Sheets("AdoDb")
            .Range("A10:BB10000").ClearContents

            If rst.RecordCount <> 0 Then

                For Champ = 1 To rst.Fields.Count
                    .Cells(10, 0 + Champ) = rst.Fields(Champ - 1).Name
                Next Champ

                .Range("A11").CopyFromRecordset rst
                rst.Close
                cnx.Close
            End If

        End With
        Set rst = Nothing
        Set cnx = Nothing
    End With
   
End Sub

Cordialement

 

[Testysql]

Merci beaucoup
effectivement ca marche très bien !!! et je vais donc reprendre cette méthode.

J'avais repris 'Recordset' sur internet sans trop savoir comment ca fonctionne..

Il me faudra peut etre prendre un cours … si je comprends bien avec cette solution plus besoin de
définir un tableau ni meme de donner un nom dans excel sur les données puiqu'ici défini par "DataTable = "[Feuil1$" & .Sheets("Feuil1").Range("A1").CurrentRegion.Address(0, 0) & "]" "

Ce qui est finalement encore mieu

A terme, je vais complexifier la requête mais je n'ajouterai 'que' des 'like' et surtout ne ramener qu'une dizaine de colonnes dans le select.

Encore merci et passez de bonnes fêtes en restant vigilant !