acceder a un dossier de fichier excel avec une macro

Question

Bonjour
j'ai fait une macro qui permet d'executer une procedure bien determinée.
y a t-il moyen que ma macro peurra acceder a un dossier sur mon disque dur, ce dossier contient une liste de fichier excel, pour que la macro sera executer sur tout les fichiers du dossier.
j'en ai vraiment besoin
je vous remercie par avance de votre aide

secourma · Answer

y a personne pour m'aider ? je perds pas espoir . je vous laisse mon email si qq'1 veut me contacter : [mailto:secourma@yahoo.fr secourma@yahoo.fr]

Merci

caco64 · Answer

Il est tout à fait possible d'ouvrir et de fermer tous les fichiers excel d'un répertoire donné et d'appliquer des procédures sur le fichier ouvert.
Il faudrait que tu précises ce que tu veux faire exactement.

La haine aveugle n'est pas sourde

secourma · Answer

merci pour l'interet que vous avez accorder a ma demande

j'explique mon probleme: sur le reseau il y a un repertoire qui contient contient un des sous repertoirs, et chaque sous repertoire contient des fichiers excels, je veux que ma macro parcours tous ces fichiers et les enregeistrer en format texte, e puis a la fin les concatener pour avoir un seul fichier texte resultat.

si vous avez une idée, faites le moi savoir

je vous remercie par avance

caco64 · Answer

Si ta macro réussit bien à enregistrer le fichier excel au format texte, ce qui ne me paraît pas le plus simple, alors ce n'est pas très difficile de réaliser cette opération sur tous les fichiers excel contenus dans des répertoires.
donne-moi le code que tu utilises pour un fichier donné et j'essaierai de te le modifier pour ce que tu souhaites faire.

La haine aveugle n'est pas sourde

secourma · Answer

Bonjour cacao64, et merci pour ton suivi,

Voici mon code qui permet d'ouvrir un fichier excel, et de parcourir toutes les feuilles du classeur et les enregeistrer en format texte.

Dim shtWorksheet As Worksheet
Dim monfichier As String

Workbooks.Open "nom du fichier"



        For Each shtWorksheet In ActiveWorkbook.Worksheets
        shtWorksheet.Activate
        Nomfeuille = shtWorksheet.Name
    
        ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "" & Nomfeuille &  ".txt", FileFormat:=xlTextWindows



        Next shtWorksheet

ActiveWorkbook.Close savechanges:=Fals

ce qui me reste maintenant c'est acceder a un repertoire situé sur le reseau, et de prcourir tt les sousrepertoires qui contiennet a leur tours des fichiers excel, et puis executer mon code sur chaque fichier.

Merci

caco64 · Answer

Salut,

comme je l'avais prédit, la difficulté ne concerne pas le la recherche des fichiers excel dans des répertoires, mais bien l'enregistrement des fichiers au format txt.
Et ce d'autant plus que lors de l'exécution de la macro, le fichier excel qui lui est associé reste le classeur actif ; et tout autre classeur ouvert ne peut être activé...

J'ai donc pas mal galéré pour modifier le code et le rendre compatible.

J'ajoute que le code fonctionne bien chez moi mais il reste encore largement améliorable notamment dans la gestion des erreurs.
En particulier, il ne gère pas le cas ou un fichier texte du même nom (d'un enregistrement précédent) existe déjà, donc prévois de rajouter la suppression des fichiers existants avant d'enregistrer.

Et surtout, il ne faut surtout pas qu'un fichier à enregistrer soit ouvert, sinon ça m... aussi (il faut aller dans le gestionnaire des tâches pour virer les processus excel en trop).

Je t'envoie le code dans un message suivant.

La haine aveugle n'est pas sourde

caco64 · Answer

C'est bien sûr la sub "lanc_proc" qui lance la procédure



Sub lanc_proc()
    Call accede_reseau("C:	est")
    'Call accede_reseau("\gauss	est")
End Sub

Sub accede_reseau(chemin As String)
Dim fs          'filesystemobject
Dim fr          'répertoire recherché sur le réseau
Dim fr_c        'collection des sous-répertoires du répertoire
Dim fr_1        '1 sous-réperoire de cette collection
Dim ff_c        'collection des fichiers du répertoire
Dim ff_1        '1 fichier de cette collection
Dim typ_fich As String
Dim nom_fich_adresse As String, nom_fich_nom As String

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fr = fs.GetFolder(chemin)
    Set fr_c = fr.subfolders
    Set ff_c = fr.Files
    
    For Each ff_1 In ff_c
        typ_fich = Right(ff_1.Name, 3)
        If typ_fich = "xls" Then
            nom_fich_nom = ff_1.Name
            nom_fich_adresse = fr.Path & "" & nom_fich_nom
            Call sauve_format_txt(nom_fich_adresse, nom_fich_nom)
        End If
    Next
    
    For Each fr_1 In fr_c
        Call accede_reseau(fr_1.Path)
    Next
End Sub

Sub sauve_format_txt(monfichieradresse As String, monfichiernom As String)

Dim xlapp As Excel.Application
Dim classeur_a_enr As Workbook
Dim feuille_a_enr As Worksheet
Dim nb_feuil As Long
Dim Nomfeuille As String
Dim adr_enr As String

    Set xlapp = New Excel.Application
    Set classeur_a_enr = xlapp.Workbooks.Open(monfichieradresse)
    nb_feuil = classeur_a_enr.Worksheets.Count
    
    For i = 1 To nb_feuil
        If i <> 1 Then
            Set classeur_a_enr = xlapp.Workbooks.Open(monfichieradresse)
        End If
        Set feuille_a_enr = classeur_a_enr.Sheets(i)
        Nomfeuille = feuille_a_enr.Name
        adr_enr = classeur_a_enr.Path & "" _
                  & Left(monfichiernom, Len(monfichiernom) - 4) _
                  & "_" & Nomfeuille & ".txt"
        
        feuille_a_enr.SaveAs Filename:=adr_enr, FileFormat:=20
        'feuille_a_enr.SaveAs Filename:=adr_enr, FileFormat:=xlText
        
        Set feuille_a_enr = Nothing
        classeur_a_enr.Close savechanges:=False
        Set classeur_a_enr = Nothing
    Next i
    Set xlapp = Nothing
End Sub






La haine aveugle n'est pas sourde

secourma · Answer

Merci beaucoup caco64 pour l'effort que vous avez fait, c'est tres gentil de votre part. votre code marche bien, j'ai fais qq petites rectifications pour qu'il prend en consideration les autres format excel a part le "xls". si non, j'ai remarqué que l'execution prend un peu de temps. y a t-il moyen de le rendre plus rapide pendant l'execution ? merci

caco64 · Answer

Je suis heureux que tu aies réussi à l'adapter.

Pour ce qui est du temps, je ne suis pas très qualifié pour te répondre précisément. A mon sens, les opérations d'entrée/sortie sont des opérations très consommatrices en temps et là le programme passe son temps à ouvrir et fermer les fichiers excel. Il le fait autant de fois qu'il y a de feuilles à enregistrer en fait, et ça prend donc beaucoup de temps.
Mais je n'ai pas trouvé de moyen de faire autrement, puisque la commande savecopyas ne permet pas de sauvegarder au format texte.

Dans le code, la commandeSet xlapp New Excel.Application        ....       xlapp nothing 
est répétée autant de fois qu'il y a de fichiers excel.
Cette commande est en fait nécessaire une seule fois. Si elle prend du temps (ce que je n'ai pas testé mais qui est une possibilité), il est alors possible d'en gagner en l'enlevant de la sub sauve_format et en la plaçant dans la sub lanc_proc (au début pour set xlapp et à la fin pour xlapp = nothing).

Après, je ne sais pas ce que tu appelles lent. Je l'ai testé sur un répertoire renfermant une dizaine de fichiers excel et ça ne prenait pas 30s. C'est long pour ce qu'il y a à faire mais ce n'est pas problématique.
Donc, soit ton nombre de fichiers à traiter est très volumineux, soit c'est ton temps d'accès au réseau qui est en cause.

Tiens-moi au courant si tu trouves quelque chose.

La haine aveugle n'est pas sourde

caco64 · Answer

J'ai joint le geste à la parole et figure-toi que c'est plutôt efficace...

J'ai rajouté un timer pour tester tout ça, résultat :
8.6s contre 31.8s avant !
Ca divise pratiquement le temps par 4, c'est toujours ça.

Je te conseille de faire les modif. Par contre, en plus de ce que je t'ai dit, il faut aussi mettre la commande Dim xlapp As Excel.Application en haut de page (en dehors des sub) pour rendre la variable publique comme indiqué ci-dessous :

Dim xlapp As Excel.Application

Sub lanc_proc()
Dim temps_exec As Single
    temps_exec = Timer
    Set xlapp = New Excel.Application
    Call accede_reseau("C:	est")
    Set xlapp = Nothing
    temps_exec = Timer - temps_exec
    MsgBox temps_exec
End Sub

La haine aveugle n'est pas sourde

secourma · Answer

j'ai rajouté le timer avant et apres midification, et j'ai constaté qu'il ya changement, mais je prefere tester ca sur mon ordinateur au travail pour vous donner le constat exact. parce que je fais pas confiance a  mon home PC.

demain vous aurez la reponse, et merci encore.

secourma · Answer

Bonjour cacao64
desolé pour le retard , j'etais absent. pour ta macro ca fonctionne tres bien. une fois les modifications effectuées, le temps d'execution deminu.

je vous remercie vivement pour votre aide, et votre partage de votre savoir. merci beaucoup et a la prochaine

caco64 · Answer

Ok, c'est sympa à toi de me tenir au courant.
Tant mieux si ça améliore un peu les choses.

A la prochaine.

La haine aveugle n'est pas sourde

sauvageon93 · Answer

Je suis tombé sur le code j'ai testé rapidement. Il faut encore que je fasse quelques modification pour l'adapter a mon besoin mais le code est très fonctionnel.

Merci beaucoup pour ce code qui est super ;)

caco64 · Answer

Content de voir qu'il a pu reservir.
Bon courage.

La haine aveugle n'est pas sourde

sauvageon93 · Answer

tu as penser a le mettre en code source ? ça pourrais être pas mal

Acceder a un dossier de fichier excel avec une macro

16 réponses

Votre réponse

Discussions similaires