Import de fichiers multiples

[Willyava]

Bonjour,

J'aimerai importer à la suite une soixantaine de fichier (avec un format inconnu pour excel) en lui précisant que toutes les colonnes sont séparées par des point-virgules. Excel ne doit pas importer par rapport aux noms des fichiers, mais par rapport au dossier. (Importer tous les fichiers d'un dossier).
Parce que tous les mois des fichiers différents vont remplacer les anciens dans ce même dossier.
Les fichiers ont tous la même structure en colonnes, mais pas en nombre de lignes.

J'aimerais que toutes les colonnes de mes dits fichiers soient copiées collées les unes à la suite des autres.

En essayant d'ouvrir l'un de mes fichiers avec l'enregistreur de macro, cela m'a donné ce code :

Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
        TrailingMinusNumbers:=True

Je me suis permis de reprendre un code que j'ai trouvé dans un autre topic, et que j'ai transformé un peu en enlevant de la mise en page :

Sub general()
    Application.ScreenUpdating = False
    
    
    'declaration de variable
    Dim objFSO As Object
    Dim objDossier As Object
    Dim objFichier As Object
    
    'initialisation des variables
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'definit le repertoire ou se trouvent les feuilles a traiter
    Set objDossier = objFSO.GetFolder("D:\blabla\RecupCDR")
    
    'pour chaque classeur dans le répertoire
    For Each objFichier In objDossier.Files
        'ouvre le classeur
        Workbooks.Open objFichier
        
        'lance la méthode copierColler pour toute les cellules a copier
        'nom
        copierColler "C4", 1
        'prenom
        copierColler "F4", 2
        'adresse
        copierColler "C5", 3
        'numero de rue
        copierColler "G5", 4
        'code postal
        copierColler "C6", 5
        'ville
        copierColler "E6", 6
        'date de naissance
        copierColler "C7", 7
        'tel fixe
        copierColler "F7", 8
        'telephone portable
        copierColler "C8", 9
        'adresse mail
        copierColler "E8", 10
        'Carte LAC
        copierColler "C9", 11
        'Date effet
        copierColler "E9", 12
        
        'ferme le classeur client sans sauvegarder
        Workbooks(Workbooks.Count).Close saveChanges:=False
        
    Next
    
 
    With ThisWorkbook.Sheets(1)
            
        'copie la feuille vers un nouveau classeur
        .Copy
     
    End With
 
    'efface les cellules dans thisworkbook
    ThisWorkbook.Sheets(1).Cells.Clear
    
    'renome la feuille qui vient d'etre copiée
    Workbooks(Workbooks.Count).Sheets(1).Name = "RecupCDR"
 
    'enregistre le nouveau classeur dans le repertoire de destination
    Workbooks(Workbooks.Count).SaveAs "D:\FICHIER_RecupCDR.xls"
    
    'ferme le nouveau classeur
    Workbooks(Workbooks.Count).Close
    
    Application.ScreenUpdating = True
 
End Sub
 
'méthode qui copie une donnée depuis le classeur client vers thisworkbook
Public Sub copierColler(rangeSource As String, colonneDestination As Integer)
    With ThisWorkbook
        'si la cellule est vide
        If Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource) = "" Then
            'on la remplit avec qqc
            Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource) = "_"
        End If
        'copie la cellule depuis le classeur client
        Workbooks(Workbooks.Count).Sheets(2).Range(rangeSource).Copy
        'colle dans la colonne qui va bien dans thisworkbook
        .Sheets(1).Cells(lastRow(.Name, .Sheets(1).Name, colonneDestination) + 1, colonneDestination).PasteSpecial
    End With
End Sub
 
'methode qui permet de connaitre la derniere ligne d'une colonne
Public Function lastRow(leClasseur As String, laFeuille As String, laColonne As Integer)
    lastRow = Workbooks(leClasseur).Sheets(laFeuille).Cells(65536, laColonne).End(xlUp).Row
End Function

Ce code me permet d'avoir une bonne base pour ma macro.

J'aimerai maintenant modifier la partie que l'on applique à tous les fichiers du dossier.
Au lieu d'ouvrir simplement un fichier .xls, ici c'est un fichier .ok (non reconnu par excel) qu'il faut ouvrir. Donc je dois implémenter à ce code (quelque part je ne sais où) quelque chose comme ça :

Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
        TrailingMinusNumbers:=True

pour qu'Excel ouvre le fichier en délimitant les colonnes grâce aux point-virgules présents.

Ensuite il faut non pas que je copie une seule cellule (coordonnées XY) mais toute la colonne X, et que je la colle sur la colonne X' du nouveau fichier.

Mon problème c'est que je n'y connais rien en VBA et que j'ai beau me documenter mais j'ai vraiment du mal à comprendre !

Merci d'avance pour votre aide

 

[mromain]

Re : Import de fichiers multiples

Bonjour Willyava,

C'est à la racine de quel dossier qu'il cherche le dossier Fichiers pour import ?

As-tu essayé de lire les macros que je t'ai envoyé ?
Elles étaient commentées afin que tu puisses les adapter :
Dans la macro du post #6 :

...(il faut adapter le chemin du dossier contenant les fichiers .ok ainsi que le nom de la feuille d'import).

...
    'définir le chemin du dossier contenant les fichier .ok
    pathDossier = "E:\fichiersMacro"
...

Dans la macro du post #13 :

...
    'définir le chemin du dossier contenant les fichier .ok
    'ici : le dossier nommé "Fichiers pour import" présent à la racine de ce fichier excel
    pathDossier = ThisWorkbook.Path & "\Fichiers pour import"
...

Tu peux donc choisir quelle méthode tu veux :
> spécifier un chemin "en dur" dans la macro (première méthode)
> spécifier un nom de dossier (celui contenant les fichiers .ok). Ce dossier doit être à la même racine que le fichier Excel contenant la macro (deuxième méthode).

J'aurais aimé savoir aussi si on peut faire disparaitre le bouton "Lancer l'import" une fois la procédure finie ?

Je viens de me replonger dans tout ça, et je me demandais si la macro était attaché à la feuille que tu m'as envoyé ?
Je veux dire, tout ce code, je ne peux pas l'utiliser en dehors de la feuille que tu m'as envoyé ?

Si je veux lancer cette opération sur une nouvelle feuille je fais comment ?

Merci de votre aide

Le mieux je pense serait de créer un nouveau classeur avec une seule feuille contenant le résultat de l'extraction (donc sans code derrière et sans bouton) et d'enregistrer/fermer ce nouveau classeur.

Qu'en penses-tu ?

a+

 

[Willyava]

Re : Import de fichiers multiples

Le mieux je pense serait de créer un nouveau classeur avec une seule feuille contenant le résultat de l'extraction (donc sans code derrière et sans bouton) et d'enregistrer/fermer ce nouveau classeur.

Qu'en penses-tu ?

Excellent ! Est-il possible d'insérer cela dans la macro ?

Du coup, la feuille d'extraction (avec le bouton) importe tous les fichiers, puis copierait et collerait l'extraction dans un nouveau classeur, et pour finir se fermerait de lui-même pour ne laisser apparent que le nouveau classeur avec le résultat de l'extraction si j'ai bien compris ?

 

[mromain]

Re : Import de fichiers multiples

Re bonjour,

Voici la macro modifiée :
> extraction dans un nouveau classeur ;
> fermeture du fichier contenant la macro d'extraction et le bouton.

Private Sub Btn_Import_Click()
'déclaration des variables
Dim feuilleImport As Excel.Worksheet, tabStr() As String, pathDossier As String, iL As Long, iO As Long
Dim myFso As Object, dossier As Object, fichier As Object, fichierT As Object
    
    'définir la feuille d'import
    'ici : la feuille d'un nouveau classeur
    Set feuilleImport = Application.Workbooks.Add(xlWBATWorksheet).Sheets(1)
    'définir le chemin du dossier contenant les fichier .ok
    'ici : le dossier nommé "Fichiers pour import" présent à la racine de ce fichier excel
    pathDossier = ThisWorkbook.Path & "\Fichiers pour import"
    
    'récupérer le dossier contenant les fichier .ok
    Set myFso = CreateObject("Scripting.FileSystemObject")
    Set dossier = myFso.GetFolder(pathDossier)
    
    'effacer les données de la feuille d'import
    feuilleImport.Cells.Clear
    
    'bouler sur chaque fichier du dossier
    For Each fichier In dossier.Files
        'vérifier que le fichier est bien un .ok
        If fichier.Name Like "*.ok" Then
            'ouvrir le fichier en lecture seule
            Set fichierT = myFso.OpenTextFile(fichier.Path, 1)
            'boucler sur chaque ligne du fichier
            While Not fichierT.AtEndOfStream
                'récupérer dans un tableau chaque élément de la ligne (séparés par un ;)
                tabStr = Split(fichierT.ReadLine, ";")
                'incrémenter la ligne d'écriture
                iL = iL + 1
                'boucler sur chaque élément de la ligne
                For iO = LBound(tabStr) To UBound(tabStr)
                    'écrire les éléments de la ligne dans les cellules
                    feuilleImport.Range("A" & iL).Offset(0, iO).Value = tabStr(iO)
                Next iO
            Wend
        End If
    Next fichier
    
    'fermer ce classeur excel
    ThisWorkbook.Close False
End Sub

a+

 

[Willyava]

Re : Import de fichiers multiples

Excellent ! Merci encore pour ton travail formidable

Tout fonctionne à merveille !

Longue vie à ce forum et aux participants !

 

[Willyava]

Re : Import de fichiers multiples

Je suis désolé mais je viens d'avoir un souci avec la macro ...
Sur mon PC tout fonctionne, mais j'ai voulu transférer le tout sur un autre car ce sera mieux pour moi de faire cela sur l'autre.
Sauf que sur l'autre j'ai Office 2007 et que le bouton Lancer l'import ne fonctionne pas.

Comment puis-je arranger cela ?

 

[mromain]

Re : Import de fichiers multiples

Je suis désolé mais je viens d'avoir un souci avec la macro ...
Sur mon PC tout fonctionne, mais j'ai voulu transférer le tout sur un autre car ce sera mieux pour moi de faire cela sur l'autre.
Sauf que sur l'autre j'ai Office 2007 et que le bouton Lancer l'import ne fonctionne pas.

Comment puis-je arranger cela ?

Re,

Bizarre, regarde si ça ne vient pas de la gestion de la sécurité des macros d'Excel. Regarde par ici pour modifier le niveau de sécurité.

a+