[VBA] - Import BDD (.xlsx) via connexion ADODB = erreur format

Le 10/01/2021 à 17:20

Bonsoir,

Pour l'import d'une BDD j'ai adapté un une macro pour récupérer des documents au format .xlsx.

Tout fonctionne bien, si ce n'est que les en-têtes des colonnes de dates et de valeurs numériques n'apparaissent pas.

Compte tenu du fait que l'en-tête est du texte et que le reste de la colonne contient un format différent, peut-être qu'il y a un conflit SQL ou quelque chose du genre ? (Je n'y connais rien dans le domaine..).

Voici la macro que j'utilise :

Public Sub Import_Data() '[Maj depuis http://silkyroad.developpez.com/VBA/ClasseursFermes/]
Dim source$, fichier$, fe$, lastfich$, sFeuille$, fich, wbks As Workbook, wbkc As Workbook, ddt As Date
Dim oSource As ADODB.Connection, oRS As ADODB.Recordset, oCommand As ADODB.Command

    If ActiveSheet.Name <> "BDD_SAISIE_FLORE" Then
        Set wbkc = ThisWorkbook: fe = ActiveSheet.Name
        fich = Application.GetOpenFilename("Fichiers Csv,*.csv")

        If ActiveSheet.Name <> "BDD_SAISIE_FLORE" And Not fich Like "*" & nmfe & "*" Then
            If ActiveSheet.Name <> "BDD_SAISIE_FLORE" And Not fich Like "*" & nmfe2 & "*" Then
                MsgBox "Pour cette étape, veuillez choisir un document dont le nom contient : " & nmfe & " ou " & nmfe2, vbCritical: chk2 = chk2 + 1: Exit Sub
            End If
        End If

        If Not fich = False Then
            Set wbks = Workbooks.Open(fich, local:=1)
            wbkc.Sheets(fe).Cells.clear
            wbks.ActiveSheet.Cells.Copy wbkc.Sheets(fe).Cells
            wbks.Close 0: Exit Sub
        Else
            MsgBox "Vous n'avez choisi aucun fichier", vbCritical, "Absence de sélection": chk2 = chk2 + 1
        End If
    End If

    If ActiveSheet.Name = "BDD_SAISIE_FLORE" Then
      Set wbkc = ThisWorkbook: fe = ActiveSheet.Name
      source = ThisWorkbook.Path & "\Bases de données\"
      fich = Dir(source & "*BDD_SAISIE_FLORE_*" & "*.xlsx")
      ddt = DateSerial(1, 1, 1)
      Do While fich <> ""
        If FileDateTime(source & fich) > ddt Then
          lastfich = source & fich
          sFeuille = Replace(fich, ".xlsx", "") & "$"
          ddt = FileDateTime(source & fich)
        End If
        fich = Dir
      Loop
    fich = lastfich
    End If

    If fich = False Then MsgBox "Aucun fichier sélectionné" & vbCrLf, vbCritical: Exit Sub
    If Dir(fich) = "" Then MsgBox "Fichier absent" & vbCrLf & fich, vbExclamation: Exit Sub

    Set oSource = New ADODB.Connection
    oSource.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & fich & ";Extended Properties=""Excel 12.0;HDR=NO"";"

    Set oCommand = New ADODB.Command
    With oCommand
        .ActiveConnection = oSource
        .CommandText = "SELECT * FROM [" & sFeuille & "]"
    End With

    Set oRS = New ADODB.Recordset
    oRS.Open oCommand, , adOpenKeyset, adLockOptimistic

    Set oRS = oSource.Execute("[" & sFeuille & "]")
    ActiveSheet.Range("A1").CopyFromRecordset oRS

    oRS.Close: oSource.Close
    Set oSource = Nothing: Set oRS = Nothing: Set oCommand = Nothing
End Sub

Avez-vous une idée de ce que je pourrais faire pour résoudre ce petit souci ?

Je vais faire une base de données pour l'exemple !

EDIT :

Pour a faire fonctionner, il faut mettre la base de données dans le même chemin d'accès que le fichier "Charger_BDD_connexion_ADODB" ; mais dans un dossier nommé : "Bases de données"

24bdd-saisie-flore-2021-01-10-23.xlsx (16.01 Ko)
30charger-bdd-connexion-adodb.xlsm (23.46 Ko)

Merci de votre attention

A plus tard !

Le 11/01/2021 à 13:06

Bonjour,

une proposition. remplace la fin de ton code par ceci

  'récupération des entêtes
    Set oSource = New ADODB.Connection
    oSource.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & fich & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"

    Set oCommand = New ADODB.Command
    With oCommand
        .ActiveConnection = oSource
        .CommandText = "SELECT * FROM [" & sFeuille & "] where 1=0"
    End With

    Set oRS = New ADODB.Recordset
    oRS.Open oCommand, , adOpenKeyset, adLockOptimistic
    ActiveSheet.Range("A1").CopyFromRecordset oRS

    oRS.Close: oSource.Close

    'récupération des données
    oSource.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & fich & ";Extended Properties=""Excel 12.0;HDR=yes;IMEX=0"";"

    Set oCommand = New ADODB.Command
    With oCommand
        .ActiveConnection = oSource
        .CommandText = "SELECT * FROM [" & sFeuille & "]"
    End With

    Set oRS = New ADODB.Recordset
    oRS.Open oCommand, , adOpenKeyset, adLockOptimistic
    ActiveSheet.Range("A2").CopyFromRecordset oRS

    oRS.Close: oSource.Close
    Set oSource = Nothing: Set oRS = Nothing: Set oCommand = Nothing
End Sub
Le 11/01/2021 à 16:44

Bonjour,

Lorsque j'ai testé votre macro, la première ligne restait vide, tout le reste était bien importé.

Alors j'ai voulu modifier la première partie de votre macro qui permet d'importer la première ligne, j'ai supprimé "where 1 = 0"

    Set oSource = New ADODB.Connection
    oSource.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & fich & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"

    Set oCommand = New ADODB.Command
    With oCommand
        .ActiveConnection = oSource
        .CommandText = "SELECT * FROM [" & sFeuille & "]" ' where 1=0
    End With

    Set oRS = New ADODB.Recordset
    oRS.Open oCommand, , adOpenKeyset, adLockOptimistic
    ActiveSheet.Range("A1").CopyFromRecordset oRS

    oRS.Close: oSource.Close

Et maintenant tout est importée, directement depuis cette partie la de la macro. La suite n'est donc plus nécessaire.

Savez-vous à quoi sert le where 1=0?

La seule différence avec la macro initiale vient de là : "Data Source=" & fich & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"

A quoi correspond IMEX= 1 ?

En tout cas merci pour votre aide !

J'espère que la solution ne sera pas que temporaire !

Bonne journée :)

Le 11/01/2021 à 17:37

Bonjour,

la proposition faite est un contournement du problème, car je n'ai pas compris d'où vient l'erreur. Et la propositioin fonctionne correctement chez moi (office 365) (entête ok, et format des données ok).

explications :

Pour avoir uniquement les entêtes, je fais une sélection des données avec une condition qui ne sera jamais vraie (where 1=0). Dans ce cas en principe, le select ne renverra que l'entête sans données.

HDR=Yes : il faut considérer que la première ligne de la réponse est un entête (et donc l'ignorer)

HDR=No : il faut considérer que les données commencent à la première ligne (ne pas ignorer la première ligne de la réponse)

IMEX=1, indique que l'on veut considérer toutes les données comme étant du texte (indépendamment de leur type (date, nombre ...)).

IMEX=0, dans la réponse il faut maintenir le type de données (date, nombre, texte, ....)

sans le where 1=0 et avec IMEX=1 et HDR=No, tout va être bien chargé, mais toutes les données seront considérées comme du texte. Si cela ne pose pas de problème pour la suite, la deuxième partie de ma proposition n'est plus nécessaire et on peut simplifier le code comme tu l'as fait.

J'espère que la solution ne sera pas que temporaire !

Je ne peux pas le garantir, car je n'ai pas d'explication valable pour le problème que tu rencontres (ça m'a tout l'air d'être un bug de oledb).

Le 12/01/2021 à 18:31

Bonsoir,

Merci pour les explications.

A priori, les données importées sont correctement affichées. Si dans la suite des macros je constate que des problèmes de format surviennent à cause de la base de données, je saurai où chercher !

Bonne fin de journée !

Le 16/01/2021 à 16:26

Bonjour,

Comme je le craignais ; j'ai enregistré la base de données en .xlsx que j'ai voulu réouvrir par la même procédure et là à l'étape :

oRS.Open oCommand,

le code passe directement à la fin de la macro en sautant tout ce qui se trouve après et sans indiquer d'erreur.

Voici la BDD qui est utilisée en l'occurrence :

15bdd-saisie-flore-2021-1-16-18.xlsx (59.74 Ko)

Je reviens vers vous si je trouve d'où ça provient.

EDIT : Je pense que ça vient du nom de la feuille. Lorsque je travaillais avec des .csv , le nom de la feuille correspondait avec le nom du document. Mais ça ne semble pas être le cas quand j'enregistre en .xlsx

Bonne journée !

Le 16/01/2021 à 17:08

Bonjour,

Pour info voici la différence entre une requête sur csv et une sur xlsx (ou xlsm) :

* csv : on se connecte au dossier contenant le ou les csv et la ou les tables requêtées correspondent aux noms des csv

* xlsx (ou xlsm) : on se connecte au fichier (chemin inclus) et la ou les tables requêtées correspondent aux noms des onglets du fichier

Pierre

Ci joint script de connexion pour Csv et pour xls

32ado-script-connexion.txt (632.00 Octets)
Le 16/01/2021 à 17:20

Bonjour,

Oui voilà, le problème provenait du nom de la feuille. J'ai adapté la macro et, a priori, tous les imports fonctionnent désormais.

Merci pour l'aide apportée sur ce post !

Bonne journée !

Le 17/01/2021 à 10:31

bonjour,

"Data Source=" & fich & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"

Extended Properties=type de fichier

HDR=La première ligne est le nom des champs Yes/No

IMEX=ne pas tenir compte du type de champ

le type de champs est défini par AdoDb par apprentissage, il faut 8 ligne pour que ADO analyse les données!

dans ton fichier tu as une entête qui porte le nom date et toutes les autre ligne ont des date valide par exemple! vue que tu as défini HDR=No la première ligne n'est pas prise en compte vue qu'elle ne contient pas une date mais un text

IMEX=1 permet de ne pas tenir compte du type de champ!

With New ADODB.Connection
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & fich & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"

    ActiveSheet.Range("A1").CopyFromRecordset .Execute("SELECT * FROM [" & sFeuille & "]")

  .Close
End With
Rechercher des sujets similaires à "vba import bdd xlsx via connexion adodb erreur format"