Macro ouverture de fichiers

Résolu/Fermé

Damien@ Messages postés 28 Date d'inscription vendredi 14 septembre 2007 Statut Membre Dernière intervention 6 février 2015 - 12 janv. 2011 à 22:11
Damien@ - 25 janv. 2011 à 18:47

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

A voir également:

Macro ouverture de fichiers
Wetransfer gratuit fichiers lourd - Guide
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Explorateur de fichiers - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur

7 réponses

Réponse 1 / 7

Patrice67
Modifié par Agi67 le 13/01/2011 à 08:31

Post annulé

Réponse 2 / 7

Patrice67
12 janv. 2011 à 23:16

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\test.txt") For Input As #1
Input #1, Data
Close #1

Cdlmt

Patrice

Réponse 3 / 7

Damien@
13 janv. 2011 à 09:59

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

Réponse 4 / 7

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
13 janv. 2011 à 10:43

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 ;-))

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 7

Damien@
14 janv. 2011 à 16:31

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

Réponse 6 / 7

Julio33
25 janv. 2011 à 14:25

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

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
25 janv. 2011 à 14:35

Bonjour,
Que viens faire ici : Sub Macro_Launch_all() en haut de macro???
Essaye ceci :

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_2bis() 
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

Copie/colle tout ce code, sans rien ajouter, dans un module standard et essaye le...

Réponse 7 / 7

Damien@
25 janv. 2011 à 18:47

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

Discussions similaires

comment donner les droits sur fichier partage

Question PIX

Chemin Logo du site de la Cité de l'espace

Discussions similaires

Newsletters