XL 2013 excercice2 ADO récupération de données de type différent dans la même colonnes

patricktoulon

XLDnaute Barbatruc
bonjour a tous

il arrive parfois dans un tableau d'avoir des données de type different dans la meme colonne
et la lecture avec ADO n'aime pas vraiment ça

les données sont manquantes
VB:
Sub testAdO()
    Dim fichier As String, nomfeuille As String, DispoCel As Range

    fichier = ThisWorkbook.Path & "\base.xlsx"
    
    nomfeuille = "Feuil1"
  
    Set DispoCel = Feuil1.Cells(Rows.Count, "A").End(xlUp).Offset(1)

    resADO [A1:C10], fichier, nomfeuille, [A1]
    
    
End Sub
Function resADO(Plage, fichier, nomfeuille, destination)
    Dim Cn As Object, texte_SQL$, rst As Object
  Set Cn = CreateObject("ADODB.Connection")

     Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
     ' la requête.Attention!!!!!!! à ne pas oublier le symbole "$" après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & nomfeuille & "$" & Plage.Address(0, 0) & "]"

  Set rst = CreateObject("ADODB.RecordSet")
    Set rst = Cn.Execute(texte_SQL)

    destination.CopyFromRecordset rst
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing: Set rst = Nothing

End Function

je sais que la solution existe mais je ne la connais pas
 

Pièces jointes

  • test ADO 2.xlsm
    19.1 KB · Affichages: 16
  • base.xlsx
    8.1 KB · Affichages: 4
Solution
Bonjour,

Sans avoir ouvert les fichiers, la seule solution que je connaisse pour résoudre ce problème est de rajouter IMEX=1 dans la chaîne de connection, pour forcer la lecture des données distantes en texte, ensuite de les re-typer côté client.
VB:
 Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"";"

Cordialement

[Edit] eh Bing ! @dysorthographie

Hasco

XLDnaute Barbatruc
Bonjour,

Sans avoir ouvert les fichiers, la seule solution que je connaisse pour résoudre ce problème est de rajouter IMEX=1 dans la chaîne de connection, pour forcer la lecture des données distantes en texte, ensuite de les re-typer côté client.
VB:
 Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"";"

Cordialement

[Edit] eh Bing ! @dysorthographie
 

patricktoulon

XLDnaute Barbatruc
bon ben voila merci a tous les deux ,je connaissais une méthode plus compliqué a la base qui consistait a boucler sur les field et a les traiter 1 par 1 mais la requête je me souvient était compliqué
donc pour la conversion ben c'est simple je ne m’embête pas je balance le transpose du (getrows) dans un variable tableau et hop!! la conversion se fait toute seule
me reste plus qu'a balancer le tableau dans la feuille

VB:
Sub testAdO()
    Dim fichier As String, nomfeuille As String, DispoCel As Range

    fichier = ThisWorkbook.Path & "\base.xlsx"
    
    nomfeuille = "Feuil1"
  
    Set DispoCel = Feuil1.Cells(Rows.Count, "A").End(xlUp).Offset(1)

    resADO [A1:C10], fichier, nomfeuille, [A1]
    
    
End Sub
Function resADO(Plage, fichier, nomfeuille, destination)
    Dim Cn As Object, texte_SQL$, rst As Object, tbl
  Set Cn = CreateObject("ADODB.Connection")

    
     Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"";"
    
    
     ' la requête.Attention!!!!!!! à ne pas oublier le symbole "$" après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & nomfeuille & "$" & Plage.Address(0, 0) & "]"

  Set rst = CreateObject("ADODB.RecordSet")
    Set rst = Cn.Execute(texte_SQL)
 'soit on copyfrom et apres on formate les colonnes
 'destination.CopyFromRecordset rst
  'soit on envoie tout
  tbl = Application.Transpose(rst.GetRows)
  
   destination.Resize(UBound(tbl), UBound(tbl, 2)) = tbl
  
     '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing: Set rst = Nothing

End Function
voila ;)
merci Messieurs :)
 

patricktoulon

XLDnaute Barbatruc
tiens pour faire propre
c'est une fonction a part entiere elle renvoie le tableau et c'est dans la sub que je met le tableau dans la feuille
VB:
Sub testAdO()
    Dim fichier As String, nomfeuille As String,tbl

    fichier = ThisWorkbook.Path & "\base.xlsx"

    nomfeuille = "Feuil1"

    tbl = GetTableOnClosedFich3([A1:C10], fichier, nomfeuille, False)

    [A1].Resize(UBound(tbl), UBound(tbl, 2)) = tbl

End Sub
Function GetTableOnClosedFich3(Plage, fichier, nomfeuille, Optional header As Boolean = False)
    Dim Cn As Object, texte_SQL$, rst As Object, tbl, head$

    Set Cn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.RecordSet")

    head = Array("NO", "YES")(Abs(header))

    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=" & head & ";IMEX=1"";"

    ' la requête.Attention!!!!!!! à ne pas oublier le symbole "$" après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & nomfeuille & "$" & Plage.Address(0, 0) & "]"

    Set rst = Cn.Execute(texte_SQL)
    GetTableOnClosedFich3 = Application.Transpose(rst.GetRows)
    Cn.Close: Set Cn = Nothing: Set rst = Nothing    '--- Fermeture connexion ---et vidage des object dans la memoire

End Function

propre et net ;)
 

dysorthographie

XLDnaute Impliqué
VB:
Function GetTableOnClosedFich3(Plage, fichier, nomfeuille, Optional header As Boolean = False)
Dim MyAddress As String,texte_SQL  As String

MyAddress = Plage.Address
If CBool(InStr(1, MyAddress, ":")) = False Then MyAddress = MyAddress & ":" & MyAddress
MyAddress = Replace(MyAddress, "$", "")
texte_SQL = "SELECT * FROM [" & nomfeuille & "$" & MyAddress & "]"

With CreateObject("ADODB.Connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=" & Array("NO", "YES")(Abs(header)) & ";IMEX=1"";"
    GetTableOnClosedFich3 = Application.Transpose(.Execute(texte_SQL).GetRows)
    .Close
End With
End Function
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonsoir robert
oui mais la tu envoies une address pas le nom du tableau

et puis
VB:
MyAddress = Plage.Address(0,0)
If CBool(InStr(1, MyAddress, ":")) = False Then MyAddress = MyAddress & ":" & MyAddress
''''MyAddress = Replace(MyAddress, "$", "")

c'est possible ou pas le ts en entier???
 

patricktoulon

XLDnaute Barbatruc
Bonjour a tous
bon j'ai suivi le tuto de boisgontier jacques
j'ai donc ajouté un name dans ma base.xlsx correspondant au même tableau que le structuré
la récup' complète c'est nikel mais des que j 'argumente les nom de champs ça ne fonctionne plus
le tableau BD est en feuil2 de base.xlsx
 

Pièces jointes

  • base.xlsx
    10.7 KB · Affichages: 2
  • test ADO 2.xlsm
    22.1 KB · Affichages: 4

Hasco

XLDnaute Barbatruc
Bonjour,

Votre HDR = No. Alors bien-sûr il ne trouve pas de noms de champs !
De plus 'ORDER BY nom' est incorrect : il n'y a pas de champ 'nom' dans la base.

[Edit] Lorsque HDR=NO Les entêtes sont lues comme des cellules normales -> le recordset a dans sa collection FIELDS pour noms de champs : 'F1, F2, F3 etc' -> copyfromrecordset renvoie la ligne des entêtes puisque lue comme une ligne normale de données

Lorsque HDR=YES Le recordset a pour collection FIELDS les noms lu dans la première ligne, il ne sont pas compris dans les données -> CopyFromRecordset ne les renverra pas.


Cordialement
 
Dernière édition:

dysorthographie

XLDnaute Impliqué
Bonjour Patrick, bonjour le forum !
En utilisant Ado tu considères le classeur comme une base de données, les onglets comme des tables et les colonnes comme des champs.

Comme l'a dit Roblochon le HDR =True indique que la première ligne contient le nom des champs si non le nom des champs sont bien F1,F2 etc.

Les tableaux structuré sont une invention Excel ils n'ont aucun fondement dans une base de données !
 

Discussions similaires

Haut Bas