Impossible d'importer un module en VBA

Arpette

XLDnaute Impliqué
Bonsoir à toutes et à tous,
j'ai un message d'erreur sur la ligne #Set VBProj = wb.VBProject# Erreur 1004 la méthode a échoué.
PS : je ne vois plus les balises

Voici le code complet :
Sub imp_module()
Dim nf%, fbas$, f$
Dim wb As Workbook
Dim i&
Dim VBProj As Object
Dim oldMod As Object

Rep = "F:\Trames\Module\"
fbas = Rep & "Module3.bas"
Application.ScreenUpdating = False
Application.EnableEvents = False

f = Dir(Rep & "*.xls")
Do While f <> "" 'boucle sur les fichiers du répertoire
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(Rep & f) 'ouvre le fichier
Set VBProj = wb.VBProject
Set oldMod = ActiveWorkbook.VBProject.VBComponents("module3")
ActiveWorkbook.VBProject.VBComponents.Remove oldMod
Application.VBE.ActiveVBProject.VBComponents.Import (fbas)
On Error GoTo 0
Set VBProj = Nothing
Set CodeMod = Nothing
wb.Close True
End If
f = Dir()
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Merci de votre aide
@+
 

job75

XLDnaute Barbatruc
Bonjour Arpette, le forum,

Puisque vous voulez le FileSystemObject voici une 3ème solution :
Code:
Sub CopierModules()
Dim chemin$, fso As Object, sf As Object, f As Object
chemin = ThisWorkbook.Path & "\" '"F:\Trames\CONTROLES CLIENTS\"
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Application.EnableEvents = False 'si nécessaire
On Error Resume Next
For Each sf In fso.GetFolder(chemin).SubFolders
  For Each f In sf.Files
    If f.Name <> ThisWorkbook.Name And f.Name Like "*.xls" Then
      With Workbooks.Open(f.Path)
        With .VBProject
          .VBComponents.Remove .VBComponents("Module2")
          .VBComponents.Import(chemin & "Module2.txt").Name = "Module2"
          .VBComponents.Remove .VBComponents("Module3")
          .VBComponents.Import(chemin & "Module3.txt").Name = "Module3"
        End With
        .Close True
      End With
    End If
Next f, sf
Application.EnableEvents = True
End Sub
Notez que f.Path donne le chemin d'accès suivi du nom du fichier.

Fichiers et les sous-dossiers zippés joints pour tester.

Bonne journée.
 

Pièces jointes

  • CopierModules(1).zip
    66 KB · Affichages: 83
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Bah en voulant trop simplifier le code j'ai fait une erreur, au lieu de :
Code:
        With .VBProject.VBComponents
          .Remove .VBComponents("Module2")
          .Import(chemin & "Module2.txt").Name = "Module2"
          .Remove .VBComponents("Module3")
          .Import(chemin & "Module3.txt").Name = "Module3"
        End With
il faut écrire :
Code:
        With .VBProject
          .VBComponents.Remove .VBComponents("Module2")
          .VBComponents.Import(chemin & "Module2.txt").Name = "Module2"
          .VBComponents.Remove .VBComponents("Module3")
          .VBComponents.Import(chemin & "Module3.txt").Name = "Module3"
        End With
Je corrige le post précédent, prenez la bonne macro.

A+
 

Arpette

XLDnaute Impliqué
Re,
Oui je comprends bien, mais ce que je veux dire, sf est un dossier qui est dans le chemin et f est un sous dossier de sf dans lequel il y a les fichiers .xls. Dans votre exemple dossier 2 n'est pas un sous dossier de dossier 1 .
En tous les cas merci de votre aide,
@+
 

job75

XLDnaute Barbatruc
Bonjour Arpette, le forum,

J'ai vu que vous êtes déçu :(

Alors si vous voulez traiter toute l'arborescence des sous-dossiers il faut une récursivité :
Code:
Dim CheminInitial$, fso As Object 'mémorisation des variables

Sub CopierModules()
CheminInitial = ThisWorkbook.Path & "\" '"F:\Trames\CONTROLES CLIENTS\"
Set fso = CreateObject("Scripting.FileSystemObject")
Copie CheminInitial
End Sub

Sub Copie(chemin$)
Dim sf As Object, f As Object
Application.ScreenUpdating = False
Application.EnableEvents = False 'si nécessaire
On Error Resume Next
For Each sf In fso.GetFolder(chemin).SubFolders
  Copie sf.Path 'récursivité pour traiter l'arborescence
  For Each f In sf.Files
    If f.Name <> ThisWorkbook.Name And f.Name Like "*.xls" Then
      With Workbooks.Open(f.Path)
        With .VBProject
          .VBComponents.Remove .VBComponents("Module2")
          .VBComponents.Import(CheminInitial & "Module2.txt").Name = "Module2"
          .VBComponents.Remove .VBComponents("Module3")
          .VBComponents.Import(CheminInitial & "Module3.txt").Name = "Module3"
        End With
        .Close True
      End With
    End If
Next f, sf
Application.EnableEvents = True
End Sub
Ci-joint les fichiers avec 4 sous-dossiers (8 fichiers étudiés).

Bonne journée.
 

Pièces jointes

  • CopierModules(2).zip
    112.7 KB · Affichages: 59

Arpette

XLDnaute Impliqué
bonsoir Job, le forum,

Avec votre code j'ai pu modifier la totalité des fichiers (3506). j'essaie maintenant sur le même principe d'exécuter le module 3 sur tous les fichiers. J'ai écrit ceci mas cela ne fonctionne pas.
VB:
Option Explicit
Dim CheminInitial$, fso As Object 'mémorisation des variables

Sub CopierModules()
CheminInitial = ThisWorkbook.Path & "\" '"F:\Trames\CONTROLES CLIENTS\"
Set fso = CreateObject("Scripting.FileSystemObject")
Copie CheminInitial
End Sub

Sub Copie(chemin$)
Dim sf As Object, f As Object
On Error Resume Next
For Each sf In fso.GetFolder(chemin).SubFolders
  Copie sf.Path 'récursivité pour traiter l'arborescence
  For Each f In sf.Files
  If f.Name <> ThisWorkbook.Name And f.Name Like "*.xls" Then
  Application.ScreenUpdating = False
  Application.EnableEvents = False 'si nécessaire
  With Workbooks.Open(f.Path)
  With .VBProject
  .Application.Run "Module3"
  End With
  .Close True
  End With
  End If
Next f, sf
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Merci de votre aide

@+
 

job75

XLDnaute Barbatruc
Bonsoir Arpette,

Là vous jouez les apprentis sorciers, un module ne s'exécute pas !!!

Si vous tenez absolument à exécuter l'une des macros (???) dans chaque fichier :
Code:
Sub Copie(chemin$)
Dim sf As Object, f As Object
Application.ScreenUpdating = False
Application.EnableEvents = False 'si nécessaire
On Error Resume Next
For Each sf In fso.GetFolder(chemin).SubFolders
  Copie sf.Path 'récursivité pour traiter l'arborescence
  For Each f In sf.Files
    If f.Name <> ThisWorkbook.Name And f.Name Like "*.xls" Then
      With Workbooks.Open(f.Path)
        With .VBProject
          .VBComponents.Remove .VBComponents("Module2")
          .VBComponents.Import(CheminInitial & "Module2.txt").Name = "Module2"
          .VBComponents.Remove .VBComponents("Module3")
          .VBComponents.Import(CheminInitial & "Module3.txt").Name = "Module3"
        End With
        Application.Run "'" & .Name & "'!Salut" '????????????????
        .Close True
      End With
    End If
Next f, sf
Application.EnableEvents = True
End Sub
Bonne nuit.
 

Arpette

XLDnaute Impliqué
Bonjour Job, oui je veux exécuter le module 3 de tous les fichiers.
Par contre je ne pas exécuter cette partie du code car déjà fait

With .VBProject
.VBComponents.Remove .VBComponents("Module2")
.VBComponents.Import(CheminInitial & "Module2.txt").Name = "Module2"
.VBComponents.Remove .VBComponents("Module3")
.VBComponents.Import(CheminInitial & "Module3.txt").Name = "Module3"
End With

Merci de votre aide.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib