Macro ouverture de fichiers Résolu

Question

Bonjour, 

je travaille avec excel 2007
J'ai actuellement une macro qui me permet d'ouvrir des fichiers .txt sous .csv
la macro commence par me demander le chemin du fichier, ensuite je clic sur le fichier et je fais ouvrir, celui est ensuite copié dans ma base, la macro me demande en suite si je veux ouvrir un autre fichier là je répond oui (car j'ai souvent de 40 à 100 fichiers à traiter)
le nombre de fichier me fait faire des erreurs ex: copie de 2 foie le même fichier ou oublie de fichiers.

ma demande est la suivante, existe t'il un moyen de dire à la macro de traiter tout les fichier contenue dans un dossier.

j'espère que ma demande est clair. pour bien me faire comprendre, je vous mais une partie de mon code.

D'avance un grand merci à tous ceux qui voudront bien se pencher sur mon problème. 

Sub Ouverture_du_fichier()

'mise en place des variable
Dim chemin_fichier
Dim nom_fichier
Dim numero_ligne_base_donnee
Dim ligne_integration_IPG

'pour ne pas voir les changements d'écran
Application.ScreenUpdating = False

'Boite de dialoque
    Dim Rep As Byte
    Rep = MsgBox("Voulez-vous ajouter des fichiers", 4 + 32)
'si l'utilisateur choisi le bouton oui
    If Rep = 6 Then
    
'début signifie le point de départ pour l'importation d'un nouveau fichier
debut:

'choix du chemein du fichier
    Application.ScreenUpdating = False
    Application.FileDialog(msoFileDialogOpen).Show

    chemin_fichier = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)

    Workbooks.OpenText Filename:=chemin_fichier, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 4), Array(13, 1), Array(14, 1), Array(15, 1)), _
        TrailingMinusNumbers:=True
    
    nom_fichier = ActiveWorkbook.Name
    

    'sélection des données à copier
    compteur_ligne = 1
    If Cells(compteur_ligne, 1).Value = "" Then Exit Sub
    
    'do et loop until est un fonction de répétion
    Do
        compteur_ligne = compteur_ligne + 1
    Loop Until Cells(compteur_ligne, 1).Value = ""
    
    'copie des données
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    
'retour sur le fichier Base
'les données sont copiées dans la base

Configuration: Windows XP / Internet Explorer 7.0

Patrice67 · Answer

Post annulé

Patrice67 · Answer

Bonjour Damien

Es-tu obligé d'ouvrir les fichiers pour récupérer les données? Tu peux à partir d'Excel lire les données directement dans tes fichiers txt.
Avec ces instructions. Il suffira ensuite de parcourir le répertoire pour traiter tous les fichiers.

  Open ("d:\ccm	est.txt") For Input As #1
    Input #1, Data
   Close #1

Cdlmt 

Patrice

Damien@ · Answer

Bonjour Patrice

ce que tu dis m'intéresse, mais dans mon cas les fichiers non jamais le même nom.
et je cherche à trouver la solution qui me permet de traiter tout les fichiers automatiquement.

je ne demande peut être l'impossible


Merci

pijaku · Answer

Bonjour,
Je suis allé faire un p'tit tour dans les astuces de CCM pour vous. Celle-ci, de Lermitte222, comporte deux-trois bouts de code qui peuvent vous être très utile, placés dans un module standard de votre classeur. Je vous les place ici :

Code dans l'entête
Option Explicit 
Public Chemin As String 
Public Fichier As String 
Const Ext = "txt" 
Sélectionner le chemin par boite de dialogue
Sub SelectionRep() 
Const ssfTous = &H1 
Dim objShell As Object, objFolder As Object, oFolderItem As Object 
    Set objShell = CreateObject("Shell.Application") 
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", ssfTous) 
    Set oFolderItem = objFolder.Items.Item 
    Chemin = oFolderItem.Path 
    Set objShell = Nothing 
    Set objFolder = Nothing 
    Set oFolderItem = Nothing 
End Sub

Lire tout les fichiers du répertoire spécifié
Sub LireRep() 
Dim fs, F, f1, s, sf 
Dim i As Long, Fin As Long 
'----------------------------------------------------------- 
    'Sélectionner le répertoir 
    SelectionRep 
'----------------------------------------------------------- 
    Set fs = CreateObject("Scripting.FileSystemObject") 
    Set F = fs.GetFolder(Chemin) 
    Set sf = F.Files 
    For Each f1 In sf 
        If LCase(Right(f1.Name, 3)) = Ext Then 
            Fichier = f1.Name 
            'placez ici votre code, ce que vous voulez faire de chaque fichier 
        End If 
    Next 
End Sub

Ne vous reste plus qu'à tester en lançant : LireRep (J'espère que Lermitte ne m'en voudra pas d'avoir changé le nom de cette macro ;-))

Damien@ · Answer

Bonjour Pijaku

Tu m'as été d'un grand secour, grace à toi j'ai résolu mon problème;

En modifiant un peu le code, c'est impec.

Merci encore

Julio33 · Answer

Bonjour Pijaku et Damien,

Je suis confronte exactement au même problème que toi Damien (avec des fichiers excel .xls), et je n'arrive pas a adapter la macro de Pijaku pour mon tableau..


Ma Macro plante a

Set F = fs.GetFolder (Chemin)


Votre aide serait grandement apprécié, je suis vraiment bloque actuellement.

Voici mes deux macros, si ca peut aider:



Sub Macro_Launch_all()

Option Explicit
Public Chemin As String
Public Fichier As String
Const Ext = "xls"

'Sélectionner le chemin par boite de dialogue'
Sub SelectionRep()
Const ssfTous = &H1
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "C:\Documents and Settings\Desktop\Nouvelles valeurs", ssfTous)
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing
End Sub




Sub Macro_Launch_all_2()

Dim fs, F, f1, s, sf
Dim i As Long, Fin As Long
'-----------------------------------------------------------
    
    'Sélectionner le répertoir
    SelectionRep
    
'-----------------------------------------------------------
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If LCase(Right(f1.Name, 3)) = Ext Then
            Fichier = f1.Name
            Application.Run "'Donnee Janvier.xlsm'!Macro2"
            'placez ici votre code, ce que vous voulez faire de chaque fichier
        End If
    Next
'
End Sub

Damien@ · Answer

Bonjour julio33

Je te met la partie de mon code qui consiste à choisir un répertoire et la macro va ensuite ouvrir les fichiers les 1 après les autres en les traitentcomme tu le souhaite.


'Code dans l'entête
Option Explicit
Public Chemin As String
Public Fichier As String
Const Ext = "txt"

'Sélectionner le chemin par boite de dialogue
Sub select_repertoire()

'pour ne pas voir les changements d'écran
Application.ScreenUpdating = False

'ouvre la boite de dialoguepour choisir un répertoire
Const ssfTous = &H1
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", ssfTous)
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing



'Lire tout les fichiers du répertoire spécifié

Dim fs, F, f1, s, sf
Dim i As Long, Fin As Long

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf

            Fichier = f1.Name

'**************************************************************
    'Indiquez ici ce que vous souhaitez faire de chaque fichier

    Fichier = ActiveWorkbook.Name
    
    
    
  
    
    Windows(Fichier).Close

'**************************************************************
    'le Next signifie que la macro retourne au début pour sélectionner le fichier suivant
    
    Next
    
    'suite de ton macro
 
    
End Sub

 
voilà en espérant que ça va t'aider

Macro ouverture de fichiers

7 réponses

Votre réponse

Discussions similaires

Newsletters