module.bas absent mais ouvert ????

carlos

XLDnaute Impliqué
Supporter XLD
Bonjour

G le code ci dessous qui me permet de remplacer tous les modules nommés 'ImporterGEP' des fichiers excel contenus dans un dossier 'EPS1'
Mon souci est que les fichiers excel ne contenant pas ce module ne devrait pas etre modifies puisque 'importergep.bas n'est pas présent(voir police rouge)...
Donc à l'instruction ci apres '.Remove .Item('importerGEP')' (en vert)
ca bug forcement puisqu'il ne peux pas fermer qqchose qui n'est ouvert .....


Sub FichiersXLS_Repertoire_RemplacementModule()
Dim Dossier As String
Dim ML As String
ML = Left(ThisWorkbook.Path, 1)
Application.ScreenUpdating = False

Dossier = ML & ':\\EPS1' 'adapter le chemin
ListFilesInFolder Dossier, True

Application.ScreenUpdating = True

End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
'necessite d'activer la reference Microsoft Scripting RunTime
'***********
'necessite d'activer la reference
'Microsoft Visual Basic for Applications Extensibility 5.3
'***********
'
' *******!!!!!!!! Attention !!!!!!!!!******************
' cet exemple remplace tous les Compiler du repertoire
'
'********************************************
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim Cible As String
Dim Wb As Workbook
Dim VBComp As Object
Dim ML As String
ML = Left(ThisWorkbook.Path, 1)
Set Fso = CreateObject('Scripting.FileSystemObject')
Set SourceFolder = Fso.GetFolder(SourceFolderName)

For Each FileItem In SourceFolder.Files

If FileItem.Type = 'Feuille de calcul Microsoft Excel' Then

'************************************************************

'MsgBox ML
'Workbooks.Open Filename:=ML & ':\\eps1\\f_ele.dbf'

' le chemin du nouveau module à importer
Cible = ML & ':\\EPS1\\Utilitaires Karl\\Module Vba Karl\\importerGEP.bas'

'ouvrir les classeurs
Set Wb = Workbooks.Open(Filename:=SourceFolderName & '\\' & FileItem.Name)
On Error Resume Next
'verifie prealablement si le module existe dans le classeur ouvert

Set VBComp = Wb.VBProject.VBComponents('importerGEP').CodeModule
On Error GoTo 0


If Not VBComp Is Nothing Then

With Wb.VBProject.VBComponents
.Remove .Item('importerGEP') 'supprime le module existant
End With
DoEvents
With Wb.VBProject.VBComponents
.Import Cible 'remplace par le nouveau module
End With
End If

Wb.Close True'refermer le classeur

'**********************************************************
End If

Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.subfolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

End Sub



Merci
 

Discussions similaires

Statistiques des forums

Discussions
312 234
Messages
2 086 475
Membres
103 226
dernier inscrit
smail12