AW: NOCH IMMER OFFEN
23.01.2004 17:46:24
Nepumuk
Hallo Jonathan,
ein Beispielcode:
Du musst in der Mappe zwei Verweise setzen.
1. Microsoft Visual Basic for Applications Extesibility 5.3
2. Microsoft Scripting Runtime
Folgenden Code in Modul1, den Code, der den alten ersetzen soll, in Modul2.
Option Explicit
Public Sub Dateien_suchen()
Dim myFileSystemObject As New FileSystemObject, myFile As File, myFileSearch As FileSearch
Dim lngIndex As Long
Application.ScreenUpdating = False
Set myFileSearch = Application.FileSearch
With myFileSearch
.LookIn = "D:\Eigene Dateien\Eigene Testmappen" 'Pfad anpassen
.FileType = msoFileTypeExcelWorkbooks
.Execute
For lngIndex = 1 To .FoundFiles.Count
Set myFile = myFileSystemObject.GetFile(.FoundFiles(lngIndex))
If myFileSystemObject.FileExists(.FoundFiles(lngIndex)) Then
If myFile.Name <> ThisWorkbook.Name Then
Application.EnableEvents = False
Workbooks.Open .FoundFiles(lngIndex)
Application.EnableEvents = True
Call Modulexport(myFile.Name)
Workbooks(myFile.Name).Close SaveChanges:=True
End If
End If
Next
End With
Set myFileSearch = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub Modulexport(strDateiname)
Dim myExportVBP As VBProject, myVBComponents As Object
Set myExportVBP = ThisWorkbook.VBProject
With Workbooks(strDateiname).VBProject
For Each myVBComponents In .VBComponents
With myVBComponents
If .Type = 100 And .Name = Workbooks(strDateiname).CodeName Then
With .CodeModule
.DeleteLines 1, .CountOfLines
.InsertLines 1, myExportVBP.VBComponents("Modul2").CodeModule.Lines(1, myExportVBP.VBComponents("Modul2").CodeModule.CountOfLines)
End With
Exit For
End If
End With
Next
End With
Set myExportVBP = Nothing
End Sub
Code eingefügt mit: Excel Code Jeanie
Jetzt nur noch den Pfad (siehe Kommentar) anpassen und das Programm tauscht bei allen Excelmappen, in dem von dir vorgegebenen Ordner, den Code von "DieseArbeitsmappe" mit dem von Modul2, der neu erstellten Mappe mit meinem Programm, aus.
Gruß
Nepumuk