Compilation fichier CSV avec définition d'une colonne au format texte

Bonjour à toute la communauté,

Après de nombreux essais et recherches infructueux, je me permets de vous solliciter afin de tenter de trouver une solution à mon problème suivant :

Je recherche à compiler de nombreux fichier .csv contenu dans un même répertoire et possédant une structure identique..

La seule condition est qu'à l'import la colonne A soit insérer au format texte.

La macro ci-après ne fonctionne pas lorsque je remplace dans la syntaxe "QueryTables.Add" le lien du fichier CSV par une variable (Fichier3) servant à récupérer le chemin du fichier à chaque itération de la boucle.

Auriez vous une astuce afin de contourner ce soucis svp ?

Sub COMPILATION_BO()
'
'Compilation des EXPORTS BO
'

Dim Chemin As String, Fichier$
Dim Fichier2, Fichier3 As String
Dim derlig, pos As Long
Dim fd As FileDialog
Dim wbanalyse As Workbook

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Set wbanalyse = ThisWorkbook

With fd
  'Définit un titre pour la boîte de dialogue
  .Title = "Selectionner le dossier source"
  .InitialFileName = ActiveWorkbook.Path & "\"
  .Show
  'Affiche le nom du dossier sélectionné
  If .SelectedItems.Count > 0 Then
    Chemin = .SelectedItems(1) & "\"
    Else
    MsgBox "Abandon", , "information"
    Exit Sub
  End If
End With

Fichier = Dir(Chemin & "*.csv")

Do While Fichier <> ""
    Workbooks.Open Filename:=Chemin & Fichier

'derniere cellule non vide colonne C
    derlig = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

'Récupération du nom du fichier d'export sans extension
    pos = InStr(Fichier, ".csv")
    Fichier2 = Left(Fichier, pos - 1)
    Fichier3 = Chemin & Fichier
    'Fichier4 = Replace(Fichier3, Chr(34), "")

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;Fichier3", Destination:=Range("A1:A" & derlig))
        '.CommandType = 0
        .Name = "Fichier2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    Range("A65536").End(xlUp).Offset(1, 0).Select
    Fichier = Dir ' Fichier suivant
Loop

End Sub

Merci à vous pour votre aide.

Il serait intéressant d'avoir au moins un fichier au format CSV.
Juste une remarque sur ta façon de déclarer tes variables. Quand tu écris :

Dim Fichier2, Fichier3 As String

Fichier2 est une Variant et Fichier3 une String

Ce n'est pas équivalent à Dim Fichier2 as String, Fichier3 As String

Bonjour Optimix,

Je vous joint un csv exemple.

Concernant les déclarations des variables Fichier, j'ai à peu près tout essayé et cela ne change pas grand chose à vrai dire.

Bien cordialement,

Bonjour,

Pour un test!

Sub test()
Const Path As String = "C:\Myrep"
Dim cible() As String
Dim Cn As Object: Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & Path & "' ;Extended Properties=""text;HDR=Yes;FMT=Delimited(,)"""
cible() = ListeTables(Cn)
For i = 0 To UBound(cible)
    ShemaIni Path, cible(i), "Delimited(;)", ShemaChamp
    With ThisWorkbook.Sheets("Feuil1")
        .Cells(.Cells.Rows.Count, "A").End(xlUp).Offset(1).CopyFromRecordset Cn.Execute("Select*From[" & cible(i) & "]")
    End With
Next
Cn.Close
MsgBox "Fin"
End Sub
Public Property Get ListeTables(Connexion As Object) As String()
Dim t() As String, i As Integer
TableToutes = False
With Connexion.OpenSchema(20)
    While Not .EOF
        ReDim Preserve t(i)
        t(i) = !TABLE_NAME
        i = i + 1
        .MoveNext
    Wend
    .Close
    ListeTables = t
End With
End Property

Public Sub ShemaIni(Rep As String, fichier As String, Delimited As String, Optional Champs As String = "", Optional NewCsv As Boolean = False)
Dim txt As String
txt = "[" & Replace(fichier, "#", ".") & "]" & vbCrLf & "Format=" & Delimited
If Champs <> "" Then txt = txt & vbCrLf & Champs
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Rep & "\schema.ini", 2, True)
NewFichier.Write txt
NewFichier.Close
If NewCsv = True Then
    Set NewFichier = fso.OpenTextFile(Rep & "\" & Replace(fichier, "#", "."), 2, True)
    NewFichier.Write ""
    NewFichier.Close

End If
Set NewFichier = Nothing
Set fso = Nothing
End Sub

Function ShemaChamp()
ShemaChamp = ShemaChamp & " Col1 = CLEGEO Text " & vbCrLf
ShemaChamp = ShemaChamp & " col2 = CLEGEO_CAR3 Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col3 = ID_IMMEUBLE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col4 = CLEGEO_DANS_RA Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col5 = CLEGEO_DANS_SADIRAH Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col6 = CLEGEO_DANS_IPE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col7 = ID_IMMEUBLE_DANS_RA Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col8 = ID_IMMEUBLE_DANS_SADIRAH Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col9 = ID_IMMEUBLE_DANS_IPE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col10 = RA_NUMERO_ACTIF Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col11 = RA_NUMERO_DATE_CREATION Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col12 = ADRESSE_EXCLUE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col13 = IPE_ETAT Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col14 = RA_X Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col15 = RA_Y Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col16 = RA_PROJECTION Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col17 = NUMERO_VOIE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col18 = EXTENSION Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col19 = TYPE_VOIE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col20 = NOM_VOIE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col21 = CODE_POSTAL Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col22 = LOCALITE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col23 = CODE_INSEE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col24 = SAD_NOMBRE_DE_LOGEMENT_A_L_ADRESSE_PARTICULIER_ET_ENTREPRISE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col25 = HZ_REFERENCE_SITE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col26 = HZ_NB_LGTS_PARTICULIERS Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col27 = HZ_NB_LGTS_PROFESSIONNELS Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col28 = HZ_NOM_ETAPE_COURANTE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col29 = HZ_DATE_DEBUT_ETAPE_COURANTE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col30 = IMMO_REFERENCE_SITE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col31 = IMMO_NB_LGTS_PARTICULIERS Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col32 = IMMO_NB_LGTS_PROFESSIONNELS Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col33 = IMMO_NOM_ETAPE_COURANTE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col34 = IMMO_DATE_DEBUT_ETAPE_COURANTE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col35 = IMMO_RAD Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col36 = IMMO_TYPOLOGIE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col37 = VTL_REFERENCE_SITE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col38 = VTL_NB_LGTS_PART Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col39 = VTL_NB_LGTS_ENT Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col40 = VTL_NOM_ETAPE_COURANTE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col41 = VTL_DATE_DEBUT_ETAPE_COURANTE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col42 = VTL_RAD Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col43 = VTL_TYPOLOGIE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col44 = PAV_REFERENCE_SITE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col45 = PAV_NB_LGTS_PART Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col46 = PAV_NB_LGTS_ENT Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col47 = PAV_NOM_ETAPE_COURANTE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col48 = PAV_DATE_DEBUT_ETAPE_COURANTE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col49 = PAV_RAD Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col50 = PAV_TYPOLOGIE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col51 = SAD_REFERENCE_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col52 = SAD_NOMBRE_DE_LOGEMENTS_CIBLE_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col53 = SAD_NOMBRE_DE_LOGEMENTS_DEPLOYE_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col54 = SAD_NOMBRE_DE_LOGEMENTS_TOTAL_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col55 = SAD_NOMBRE_DE_LOGEMENTS_ZAPM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col56 = SAD_NOMBRE_DE_LOGEMENTS_ENTREPRISE_ZAPM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col57 = SAD_NOM_ETAPE_COURANTE_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col58 = SAD_DATE_DEBUT_ETAPE_COURANTE_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col59 = SAD_IMMEUBLE_RAL Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col60 = SAD_IMMEUBLE_RAD Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col61 = SAD_STATUT_STB_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col62 = SAD_STATUT_STB_HZ Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col63 = SAD_STATUT_STB_IMMO Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col64 = SAD_STATUT_STB_VTL Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col65 = SAD_STATUT_STB_PAV Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col66 = IPE_REFERENCE_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col67 = IPE_NOMBRE_DE_LOGEMENTS_CIBLE_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col68 = IPE_NOMBRE_DE_LOGEMENTS_AU_STATUT_DEPLOYE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col69 = IPE_NOMBRE_LOGEMENTS_ADRESSE_IPE Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col70 = IPE_NOMBRE_DE_LOGEMENTS_TOTAL_PM Text " & vbCrLf
ShemaChamp = ShemaChamp & " Col71 = IPE_PBO_DE_RATTACHEMENT Text " & vbCrLf

End Function