Import de fichiers multiples

Willyava

XLDnaute Nouveau
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 :

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 :

Code:
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 :

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


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 ! :confused:

Merci d'avance pour votre aide :D
 

Willyava

XLDnaute Nouveau
Re : Import de fichiers multiples

J'aimerais bien oui mais les fichiers sont non valides pour les mettre en pièces jointes ! :rolleyes:
Ceux sont des .ok et le souci c'est que si je les renomme en .txt, ma seconde macro bug. (je viens de tester).

Puis je avoir une adresse mail pour te les envoyer directement ?
 

mromain

XLDnaute Barbatruc
Re : Import de fichiers multiples

J'aimerais bien oui mais les fichiers sont non valides pour les mettre en pièces jointes ! :rolleyes:
Ceux sont des .ok et le souci c'est que si je les renomme en .txt, ma seconde macro bug. (je viens de tester).

Puis je avoir une adresse mail pour te les envoyer directement ?
Re bonjour,

Avant de passer à cette étape, essaye de les envoyer dans un fichier zip.

a+
 

Willyava

XLDnaute Nouveau
Re : Import de fichiers multiples

Etant donné que la limite max de l'upload sur le serveur du site est de 48ko, c'est impossible que je rentre ne serait-ce que 2 ou " fichiers dedans :p

J'ai donc uploader sur un serveur Mégaupload :
Ce lien n'existe plus

Le .rar fait 700Ko environ je crois.

Merci de votre aide !
 

mromain

XLDnaute Barbatruc
Re : Import de fichiers multiples

Bonjour Willyava,

Voici un essai avec la macro suivante (il faut adapter le chemin du dossier contenant les fichiers .ok ainsi que le nom de la feuille d'import).
VB:
Public Sub ImportFilesData()
'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
    Set feuilleImport = ThisWorkbook.Sheets("Feuil1")
    'définir le chemin du dossier contenant les fichier .ok
    pathDossier = "E:\fichiersMacro"
    
    '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
End Sub
a+
 
Dernière édition:

Willyava

XLDnaute Nouveau
Re : Import de fichiers multiples

Merci beaucoup pour ton travail si rapide !

Cependant, la macro ne fonctionne pas.
Je ne saurais te dire ce qui ne fonctionne pas car je n'ai aucune erreur qui s'affiche.
Quand je lance la macro sur un classeur vierge, donc la feuille c'est bien "Feuil1" je n'y ai pas touché, mon curseur tourne comme quand l'ordi exécute un truc, mais à la fin rien.
Ma feuille est toujours vierge.

J'ai vérifié le chemin, et il est correct.
 

mromain

XLDnaute Barbatruc
Re : Import de fichiers multiples

Merci beaucoup pour ton travail si rapide !

Cependant, la macro ne fonctionne pas.
Je ne saurais te dire ce qui ne fonctionne pas car je n'ai aucune erreur qui s'affiche.
Quand je lance la macro sur un classeur vierge, donc la feuille c'est bien "Feuil1" je n'y ai pas touché, mon curseur tourne comme quand l'ordi exécute un truc, mais à la fin rien.
Ma feuille est toujours vierge.

J'ai vérifié le chemin, et il est correct.
Re bonjour,

Bizarre :confused:
La macro a pourtant été développée et testée (avec succès) sur Excel 2010 (et Win XP SP3)...
Juste à tout hasard : est-ce que tes fichiers possèdent bien une extension .ok en minuscule ?

a+
 

tototiti2008

XLDnaute Barbatruc
Re : Import de fichiers multiples

Bonjour Willyava, Bonjour mromain,

En relisant le code de mromain je ne vois pas du tout où ça peut coincer

Je suppose que tu as bien redéfini le dossier (en rouge dans son code), le mieux serait d'exécuter en pas à pas et de vérifier la valeur des variables, et le comportement du code...

Il faut mettre un point d'arrêt au début de son code puis exécuter en Pas à Pas pour voir ce qu'il fait (et surtout ce qu'il ne fait pas ;))
 

mromain

XLDnaute Barbatruc
Re : Import de fichiers multiples

Re bonjour Willyava, Tototiti

Merci pour ta vérification Tototiti ;).

L'archive jointe contient :
> un fichier Excel avec un bouton associé à la macro (juste retouchée) ;
> un dossier contenant les fichiers .ok.

Willyava, juste pour tester, dé-zipe la, ouvre le fichier Excel, et lance la macro. La macro va automatiquement chercher les fichiers .ok du dossier nommé "Fichiers pour import" présent à la racine du fichier Excel.

Sinon, je ne vois pas trop :eek:.
Dis nous si ça fonctionne chez toi.

a+
 

Pièces jointes

  • Multi import txt.zip
    38.7 KB · Affichages: 41

Willyava

XLDnaute Nouveau
Re : Import de fichiers multiples

Excellent ! Ca fonctionne !

Merci beaucoup de votre aide !

Par contre je pourrais avoir le code VBA ?
Je n'arrive pas à le trouver :p

Juste le copier coller dans un post après.

Encore merci !
 
Dernière édition:

mromain

XLDnaute Barbatruc
Re : Import de fichiers multiples

Bonjour Willyava,


En faisant clic droit sur l'onglet, puis visualiser le code, tu trouveras le code suivant :
VB:
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
    Set feuilleImport = ThisWorkbook.Sheets("Feuil1")
    '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
End Sub
a+
 
Dernière édition:

Willyava

XLDnaute Nouveau
Re : Import de fichiers multiples

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 ;)
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
293