XL 2016 Données non rapatriées via CopyFromRecordset

Polobe36

XLDnaute Occasionnel
Bonjour à tous,

Je viens vers vous car je n'arrive pas à comprendre ce qui ne fonctionne pas dans mon code.

J'intègre dans mon code VBA une "requête SQL" pour extraire des données de ma GMAO.
J'utilise habituellement le CopyFromRecordset pour que ces données soient extraites d'un bloc sur une feuille excel, sans que cela ne me pose de problème.
Hors dans ce cas précis, le contenu des champs 5 et 6 de ma requête ne sont pas extraits, les colonnes 5 et 6 sont vides.

Du coup, j'ai essayer une autre méthode d'extraction des données ligne par ligne et pour le coup aucun problème, les champs 5 et 6 sont bien rapatriés.
Le problème c'est que le temps d'exécution est terriblement plus long.

Auriez-vous une idée ?
Merci par avance à vous, bonne journée

VB:
Sub DI_EXTRACT()

Dim cnn As ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As ADODB.Recordset

MethodeExtract = 1 'pour choisir la méthode d'extraction

Sqlstring = "SELECT CSWO_MR.CODE, CSWO_WO.CODE, CSWO_MR.WORKPRIORITY, CSWO_MR.DESCRIPTION, CSSY_DESCRIPTION.RAWDESCRIPTION, CSSY_STEP.DESCRIPTION"
Sqlstring = Sqlstring & " FROM (((CSWO_MR INNER JOIN CSSY_ACTOR ON CSWO_MR.ADDRESSEE_ID = CSSY_ACTOR.ID) LEFT JOIN CSWO_WO ON CSWO_MR.WO_ID = CSWO_WO.ID) LEFT JOIN CSSY_DESCRIPTION ON CSWO_MR.LONGDESC_ID = CSSY_DESCRIPTION.ID) INNER JOIN CSSY_STEP ON CSWO_MR.STATUS_CODE = CSSY_STEP.CODE"
Sqlstring = Sqlstring & " WHERE (((CSSY_ACTOR.CODE) = 'ENGINEERING_BE') And ((CSSY_STEP.STATUSFLOW_ID) = 'MRSTATUS'))"
Sqlstring = Sqlstring & " ORDER BY CSWO_MR.CREATIONDATE;"

    Set cnn = New ADODB.Connection
    cnn.Open "DSN=****;" & "Uid=****;" & "Pwd=****"
    cmd.ActiveConnection = cnn
    cmd.CommandType = ADODB.CommandTypeEnum.adCmdText
    cmd.CommandText = Sqlstring
    Set rs = New ADODB.Recordset
    Set rs = cmd.Execute

    With Sheets("Feuil1")
        Select Case MethodeExtract
            Case 1 'Extraction ligne/ligne
                DerLigne = 2
                Do While Not rs.EOF
                    .Cells(DerLigne, 2).Value = rs(0)
                    .Cells(DerLigne, 3).Value = rs(1)
                    .Cells(DerLigne, 4).Value = rs(2)
                    .Cells(DerLigne, 5).Value = rs(3)
                    .Cells(DerLigne, 6).Value = rs(4)
                    .Cells(DerLigne, 7).Value = rs(5)
                    DerLigne = DerLigne + 1
                    rs.MoveNext
                Loop
            Case 2 'Extraction en bloc
                .Cells(2, 2).CopyFromRecordset rs
        End Select
    End With
    
    rs.Close
    cnn.Close

End Sub
 

Polobe36

XLDnaute Occasionnel
Bonjour Hasco,

Oui effectivement le test n'est pas possible, désolé.
C'est vrai que n'utilise jamais query, j'ai toujours fonctionner de cette manière et çà a toujours bien fonctionné.
Là aussi çà fonctionne parfaitement dans le cas 1.
Mais dans le second, non, et c'est que j'essaie de comprendre.

Quelque chose vous parait incohérent dans le code ? et notamment sur l'utilisation du copyfromrecordset ?

Cordialement
 

Hasco

XLDnaute Barbatruc
Re,

Ben à première vue non, mais sans pouvoir tester, difficile de vous dire autre chose.
De plus, personnellement je n'ai jamais rencontré ce problème.
Vous pouvez toujours tenter de renseigner le paramètre MaxColumns de .CopyFromRecordset qui, normalement, comme MaxRows est facultatif (.CopyFromRecordset renvoyant toutes les lignes et colonnes par défaut).

La seule incohérence avec votre question c'est que votre macro est paramétrée pour utiliser la méthode ligne à ligne (MethodeExtract =1) mais sans doute est-ce un oubli avant le copier/coller.

Cordialement
 
Dernière édition:

Polobe36

XLDnaute Occasionnel
Bonjour dysorthographie,

Un merci déjà pour ta réponse, et l'heure à laquelle tu t'es penché sur mon problème 👍

Je me suis donc appuyé des derniers post, mais cela ne marche qu'en partie.
Il me manque encore la dernière colonne, la cinquième étant bien ramenée.
Peut-être un paramétrage dans le code de la fonction "Transpose" 🧐 mais je manque de maitrise là-dessus.

Merci par avance.
 

dysorthographie

XLDnaute Impliqué
Bonjour
VB:
 Case 2 'Extraction en bloc

               tb = Transpose(rs.GetRows)
             .Cells(2, 2).Resize(UBound(tb, 1), UBound(tb, 2)) = tb
        End Select
    End With
 
    rs.Close
    cnn.Close

End Sub
Function Transpose(Ttk As Variant) As Variant
Dim T As Variant, lg As Long, cl As Long, i As Long, j As Long
    lg = UBound(Ttk, 1)
    cl = UBound(Ttk, 2)
    ReDim T(LBound(Ttk, 2) To cl, LBound(Ttk, 1) To lg)
    For i = LBound(Ttk, 2) To cl
        For j = LBound(Ttk, 1) To lg
           T(i, j) = Ttk(j, i)
        Next j
    Next i
   Transpose = T
 End Function
 
Dernière édition:

Polobe36

XLDnaute Occasionnel
Re,

Pas mieux...
Je n'arrive toujours pas à comprendre pourquoi toutes les données ne sont pas présentes alors dans le "case 1" je n'ai aucun soucis.
Mais comme la personne du post partagé, par cette méthode c'est trop long.

Voici une photo des résultats, "Case 3" étant le code que tu m'as partagé précédemment.
Capture.JPG
 
Dernière édition:

Statistiques des forums

Discussions
299 956
Messages
1 980 368
Membres
207 067
dernier inscrit
Miks57450