problème import de plusieurs fichiers csv

  • Initiateur de la discussion Initiateur de la discussion jopont
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jopont

XLDnaute Impliqué
Bonjour,

J'essaye d'importer en automatique plusieurs fichiers .csv avec le code ci-dessous.
-La macro Lire fonctionne lorsque que je l’exécuté avec un fichier.
Par contre lorsque je l'exécute depuis la macro Tst, pour traiter plusieurs fichiers CSV, j'ai une erreur sur le open Fichier for input : erreur chemin fichier

-Deuxième problème, lorsque j'importe les champs de date sont parfois inversés.

Comment résoudre ces problème. Merci
Code:
Sub Tst()
Dim Fichier As Variant
    Chemin = ThisWorkbook.Path & "\"
    Fichier = Dir(Chemin & "*.csv")
    Do While Fichier <> False
        Lire Fichier
    Fichier = Dir()
    Loop
End Sub

Code:
Sub Lire(ByVal Fichier As String)
Dim Chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur  As String * 1
 
    '  Séparateur Point Virgule
    Separateur = ";"
     
    Cells.Clear
    Application.ScreenUpdating = False
    NumFichier = FreeFile
    iRow = 1
      Open Fichier For Input As #NumFichier
        Do While Not EOF(NumFichier)
            iCol = 1
            Line Input #NumFichier, Chaine
            Ar = Split(Chaine, Separateur)
            For i = LBound(Ar) To UBound(Ar)
                Ar(i) = Replace(Ar(i), "M-", "")
                Cells(iRow, iCol) = Ar(i)
                iCol = iCol + 1
            Next
             
           'Select Case Cells(iRow, 1)
                'Case Is = Cells(iRow, 2): Cells(iRow, 3) = "Ok"
                'Case Else: Cells(iRow, 3) = "Bad"
            'End Select
             
            iRow = iRow + 1
        Loop
    Close #NumFichier
     
    Application.ScreenUpdating = True
End Sub
 
Re : problème import de plusieurs fichiers csv

Bonjour,

ça y est ça fonctionne avec la méthode de récupération via l’enregistreur de macro.
En outre mes dates sont cette fois-ci correctes.
Si j'ajoute un CSV, celui viens maintenant se coller après la dernière ligne non vide.

Dans la macro, comment forcer un répertoire de choix du CSV par défaut ?
Comment classer par date croissante ?
Merci

Code:
Sub Macro3()
         Dim fStr As String
        With Application.FileDialog(msoFileDialogFilePicker)
            .Show
            If .SelectedItems.Count = 0 Then
                MsgBox "Cancel Selected"
                Exit Sub
            End If
            'fStr is the file path and name of the file you selected.
            fStr = .SelectedItems(1)
        End With
    Worksheets("Data").Activate
        With ThisWorkbook.Sheets("Data").QueryTables.Add(Connection:= _
        "TEXT;" & fStr, Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1))
            .Name = "CAPTURE"

        .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 = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 4, 4)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
490
Réponses
5
Affichages
307
Réponses
4
Affichages
223
Réponses
5
Affichages
193
Retour