Discussion :

[Darksnakes]

Bonjour,

J'ai mis en place une macro qui sélectionne l'ensemble des fichiers nommés "EVO*.xlsx" situé dans le même dossier que le fichier qui exécute la macro et qui va chercher les lignes stockées dans un onglet "PREP_CSV" pour constituer un seul fichier CSV.

Voici la macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
Sub WriteFileADO()
 
  Dim PathName As String 'Chemin du dossier où la macro est présente
  Dim CSVFileName As String 'nom du fichier CSV final
  Dim OutputFileNum As Integer 'entier représentant le fichier
  Dim NameXLSFile As String 'Format des fichier xl qui vont être lus par la macro
  Dim ListeFileName As Variant 'Liste des fichiers présents dans le dossier
  Dim Sheet As String 'nom de la feuille qui va être lue dans chaque fichier
  Dim HeadLine As String 'entête du fichier CSV
 
 
  'Initialisation des différentes variables
  CSVFileName = "DICTIONNAIRE_CONTROLES_" & Format(Now, "yyyymmddhhNnSs") & ".csv"
  PathName = Application.ActiveWorkbook.Path
  NameXLSFile = "EVO*.xlsx"
  Sheet = "PREP_CSV"
  HeadLine = "Contrôle (Code);Code Type Contrôle;Code fréquence contrôle;Code Moyen Contrôle;Responsable du contrôle (Nom du contact);Code Service;Instance de donnée (Code);Code Modalité Contrôle;Contrôle (Nom);Contrôle (Description);Zone de risque;Flag Opérationnel;Flag contrôle Exhaustivité;Flag contrôle de pertinence;Flag contrôle d'exactitude;Description de la mesure (Contrôle OK si …);Seuil de tolérance 1;Seuil de tolérance 2;Rejet du flux;Rejet de l'enregistrement;Date de début;Date de fin;Contrainte ODI"
  OutputFileNum = FreeFile
 
  'Assure qu'il y a un backslash à la fin du nom du chemin
  If Right(PathName, 1) <> "\" Then PathName = PathName & "\"
 
  'Créé le fichier CSV dans le répertoire ou se trouve la macro
  Open PathName & CSVFileName For Output Lock Write As #OutputFileNum
 
  'Ecrit dans le fichier cible la première ligne qui contient les entêtes
  Print #OutputFileNum, HeadLine
 
  'Liste tous les fichers qui sont au format NameXLSFile dans le dossier ou est présente la macro
  ListeFileName = Dir(PathName & NameXLSFile, vbNormal)
 
  'Parcourt la liste de tous les fichiers
  While ListeFileName <> ""
 
    'Ecrit dans le fichier CSV cible la ligne CSV récupérée par la fonction GetCSVLine
    Print #OutputFileNum, GetCSVLine(Sheet, ListeFileName)
 
 
    'Passe au fichier suivant
    ListeFileName = Dir
 Wend
 
  Close OutputFileNum
 
End Sub
 
Function GetCSVLine(Sheet As String, ByVal FileName As String)
'Créée un connection au fichier FileName et retourne sous forme de chaine de caractères CSV les lignes du tableau présent dans l'onglet Sheet
 
    Dim Cn As ADODB.Connection 'objet permettant la connexion ADO au fichier FileName
    Dim SQLStatement As String 'Requête SQL pour extraire les données de la feuille Sheet
    Dim Recordset As ADODB.Recordset 'Résultat de la requête SQLStatement
    Dim NULLStr As String 'valeur si champ vide
    Dim ColDelimiter As String 'séparateur de colonne
    Dim CSVLine As String 'Chaine de caractère CSV
 
    'Initialisation des différentes variables
    NULLStr = ""
    ColDelimiter = ";"
    SQLStatement = "SELECT * FROM [" & Sheet & "$]"
 
    'Créé une connexion permetant d'intéroger le fichier en SQL
    Set Cn = New ADODB.Connection
 
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
 
    'Exécution de la requête SQLStatement
    Set Recordset = New ADODB.Recordset
    Set Recordset = Cn.Execute(SQLStatement)
 
    'Récupération du résultat au format CSV
    CSVLine = Recordset.GetString(adClipString, 1, ColDelimiter, , NULLStr)
 
    Cn.Close
    Set Cn = Nothing
 
    'Renvoie le résultat
    GetCSVLine = Left(CSVLine, Len(CSVLine) - 1)
 
End Function

Elle fonctionnait très bien, mais a priori j'ai du effectuer une modification qui fait planter la macro avec le message suivant :
"Erreur d'exécution '-2147217865 (80040e37)' : Le moteur de base de données Microsoft Acess n'a pas pu trouver l'objet PREP_CSV$....."


Merci d'avance pour votre aide.

Cordialement,

Yann

[Daniel.C]

Bonjour,

Est-ce qu'il y a une ligne de code qui est surlignée en jaune ?

[Darksnakes]

tout à fait, il s'agit de l'execute :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Recordset = Cn.Execute(SQLStatement)

[Invité]

Mot réservé (Recordset)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Set rs=createobject("adodb.recordset")
 rs.open SQLStatement Cnq

[Darksnakes]

rdurupt, j'ai modifié mais j'ai la même erreur sur le Open

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rs.Open SQLStatement, Cn

[Daniel.C]

Est-ce que l'orthographe "PREP_CSV" est correcte ? Et est-ce que la feuille existe dans le fichier "EVO*.xlsx" en cours de traitement ?