Herbers Excel-Forum - das Archiv

Bewerten Sie hier bitte das Excel-Portal

Makros aus allen XLS u. XLA-Dateien in Textdatei

Bild

Betrifft: Makros aus allen XLS u. XLA-Dateien in Textdatei
von: Reinhard
Geschrieben am: 23.09.2003 16:34:00
Hallo Wissende,
im Laufe der Zeit sammelten sich sehr viele Exceldateien bei mir an.
Nun hätte ich gern alle makros daraus in einer Textdatei um mal einen Überblick zu haben was wo steht.
Ich kopiere mir alle xl?-Dateien in ein einziges Verzeichnis und lasse mir dann nacheinander alle Dateien öffnen und nach Kopieren der Makrocodes in eine Textdatei wieder schliessen.
Mit Hilfe vom Euren Beiträgen und dem Archiv von Hans krieg ich das Öffnen und Schliessen hin.
Welchen Code brauche ich um folgendes zu tun:
(jeweilige Datei ist geöffnet, Textdatei mit Open for output as #1 auch)



Sub Code_Kopieren( ByVal Dateiname As String)
For each Tab in Tabellen
Print #1, Dateiname & Tabellenname
Print #1, Tabellencode
Next Tab
For Each Mod in Module
Print #1, Dateiname & Tabellenname
Print #1, Modulcode
Next Mod
For each Ver in Verweise
print #1, Verweis
Next Ver
End Sub

Vielen Dank für das Interesse und eventuelle Lösungsansätze *hoff*
Gruß
Reinhard
Bild

Betrifft: AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
von: Nepumuk
Geschrieben am: 23.09.2003 19:45:41
Hallo Reinhard,
wenn du nicht damit zurecht kommst, dann brauche ich von dir den Code, den du benutzt, um die Dateien zu öffnen.


Option Explicit
Public Sub test()
Dim Excelmappe As Workbook
Set Excelmappe = Workbooks("Makrohandling.xls")
Call Code_Kopieren(Excelmappe)
End Sub
Private Sub Code_Kopieren(ByVal Datei As Workbook)
Dim VBEobj As Object, zeile As Integer, item As Variant, zaehler As Integer
Open "D:\Eigene Dateien\Eigene Tabellen\TestText.txt" For Output As #1
Print #1, Datei.Name
Leerzeile 2
For Each VBEobj In Datei.VBProject.VBComponents
With VBEobj.CodeModule
zaehler = 0
For zeile = 1 To .CountOfLines
If Trim(.Lines(zeile, 1)) <> "" Then zaehler = zaehler + 1
Next
If zaehler > 1 Then
Print #1, VBEobj.Name & ":"
Leerzeile 2
For zeile = 1 To .CountOfLines
If Trim(.Lines(zeile, 1)) <> "" Then Print #1, .Lines(zeile, 1)
Next
Leerzeile 3
End If
End With
Next
Print #1, "Verweise:"
Leerzeile 2
Set VBEobj = Datei.VBProject.References
For Each item In VBEobj
Print #1, item.Description
Next
Leerzeile 3
Print #1, String(200, "-")
Leerzeile 3
Close #1
End Sub
Private Sub Leerzeile(Anzahl As Integer)
Dim zeile As Integer
For zeile = 1 To Anzahl
Print #1, ""
Next
End Sub


Code eingefügt mit: Excel Code Jeanie

Gruß
Nepumuk
Bild

Betrifft: Danke dir, melde mich ob es bei mir klappt o.w.T
von: Reinhard
Geschrieben am: 23.09.2003 20:23:40
o.w.T.=ohne weiteren Text :-)
Bild

Betrifft: klappt nicht :-( Laufzeitfehler9, Index außerhalb
von: Reinhard
Geschrieben am: 24.09.2003 12:01:35
Hallo Nepumuk,
die Dateinamen lese ich mit einer Dos-Batch (am Ende dieses Postings) ein, sie sind dann in der Datei C:\temp\xlfond.txt.
Dann gabe ich deine Test-Sub modifiziert. Beim teten mit F8 bricht Test() beim Befehl
Set Excelmappe = Workbooks(DateiName)
ab mit der Meldung Laufzeitfehler ), Index außerhalb....
Zu diesem Zeitpunkt hat die Variable Dateiname den Inhalt "C:\5andre1.xls"
Ich mutmaße ohne Ahnung dass es am Pfad liegen könnte.
Was muss ich da ändern
Gruß
Reinhard


Option Explicit
Public Sub test()
Close
Dim Excelmappe As Workbook
'Set Excelmappe = Workbooks("Makrohandling.xls")
'Call Code_Kopieren(Excelmappe)
Dim DateiName As String
Open "c:\temp\xlfound.txt" For Input As #2
While Not EOF(2)
Input #2, DateiName
Set Excelmappe = Workbooks(DateiName)
Call Code_Kopieren(Excelmappe)
Wend
End Sub
Private Sub Code_Kopieren(ByVal Datei As Workbook)
Dim VBEobj As Object, zeile As Integer, item As Variant, zaehler As Integer
Open "D:\Eigene Dateien\AllModul.txt" For Output As #1
Print #1, Datei.Name
Leerzeile 2
For Each VBEobj In Datei.VBProject.VBComponents
With VBEobj.CodeModule
zaehler = 0
For zeile = 1 To .CountOfLines
If Trim(.Lines(zeile, 1)) <> "" Then zaehler = zaehler + 1
Next
If zaehler > 1 Then
Print #1, VBEobj.Name & ":"
Leerzeile 2
For zeile = 1 To .CountOfLines
If Trim(.Lines(zeile, 1)) <> "" Then Print #1, .Lines(zeile, 1)
Next
Leerzeile 3
End If
End With
Next
Print #1, "Verweise:"
Leerzeile 2
Set VBEobj = Datei.VBProject.References
For Each item In VBEobj
Print #1, item.Description
Next
Leerzeile 3
Print #1, String(200, "-")
Leerzeile 3
Close #1
End Sub
Private Sub Leerzeile(Anzahl As Integer)
Dim zeile As Integer
For zeile = 1 To Anzahl
Print #1, ""
Next
End Sub


Die Dosbatch:
echo. | dir c:\*.xls /-p /b /s > c:\temp\xlfound.txt
echo. | dir c:\*.xla /-p /b /s >> c:\temp\xlfound.txt
echo. | dir d:\*.xls /-p /b /s >> c:\temp\xlfound.txt
echo. | dir d:\*.xla /-p /b /s >> c:\temp\xlfound.txt
echo. | dir e:\*.xls /-p /b /s >> c:\temp\xlfound.txt
echo. | dir e:\*.xla /-p /b /s >> c:\temp\xlfound.txt
echo. | dir f:\*.xls /-p /b /s >> c:\temp\xlfound.txt
echo. | dir f:\*.xla /-p /b /s >> c:\temp\xlfound.txt

Bild

Betrifft: AW: klappt nicht :-( Laufzeitfehler9, Index außerhalb
von: Nepumuk
Geschrieben am: 24.09.2003 17:01:37
Hallo Reinhard,
du musst die Mappe öffnen.
Also so:


Option Explicit
Public Sub test()
Dim DateiName As String, Pfad As String
Application.ScreenUpdating = False
Close
Pfad = "c:\temp\"
Open "c:\temp\xlfound.txt" For Input As #2
While Not EOF(2)
Input #2, DateiName
GetObject (Pfad & DateiName)
Call Code_Kopieren(Workbooks(DateiName))
Workbooks(DateiName).Close False
Wend
Application.ScreenUpdating = True
End Sub


Code eingefügt mit: Excel Code Jeanie

In die Variable Pfad muss der Pfad zu den Excelmappen stehen die nach Makros durchsucht werden sollen.
Gruß
Nepumuk
Bild

Betrifft: Danke dir, jetzt läuft es einigermaßen
von: Reinhard
Geschrieben am: 25.09.2003 16:07:43
Hallo Nepumuk,
eben brachte ich das zum Laufen *freu*
Es kommt zwar noch nach einiger Zeit der Fehler 50289, aber da davor etliche Dateien
einwandfrei durchliefen und ihr Modulcode notiert wurde, find ich schon raus wodran das liegt. *glaub*
Entweder ist die Datei gerade von Excel in Benutzung oder mit dem Dateinamen stimmt was nicht, Umlaute, Sonderzeichen,...
Dass kann ich ja dann mit on error abfangen.

Vielen Dank für deine Unterstützung Nepumuk.
Im Anhang der Code der gerade lief.
Lieben Gruß
Reinhard 


Option Explicit
Public Sub Module_Aus_XLDateien_Listen()
Dim DateiName As String 'Dateiname
Dim PfadDateiName As String 'Dateiname incl. Pfad
Dim pos As Long ' Position des letzten \ in Pfadangabe
Dim x As Long 'Schleifenzähler für Ermittlung von pos
Application.ScreenUpdating = False
Close
'In xlfound.txt stehen Zeilenweise die XLS-Dateinamen incl. Pfad
Open "c:\temp\xlfound.txt" For Input As #2
While Not EOF(2)
Input #2, PfadDateiName
GetObject (PfadDateiName)
pos = 0
For x = 1 To Len(PfadDateiName) ' Ermittlung letztes \ im Pfad
If Mid(PfadDateiName, x, 1) = "\" Then pos = x
Next x
'puren Dateinamen aus PfadDateiname extrhieren
DateiName = Mid(PfadDateiName, pos + 1, Len(PfadDateiName) - pos)
Call Code_Kopieren(Workbooks(DateiName)) 'kopiert Modulcod in D:\...\AllModul.txt
Workbooks(DateiName).Close False
Wend
Application.ScreenUpdating = True
End Sub
Private Sub Code_Kopieren(ByVal Datei As Workbook)
' von Nepumuk 09/2003
Dim VBEobj As Object, zeile As Integer, item As Variant, zaehler As Integer
Open "D:\Eigene Dateien\AllModul.txt" For Append As #1
Print #1, Datei.Name
Leerzeile 2
For Each VBEobj In Datei.VBProject.VBComponents
With VBEobj.CodeModule
zaehler = 0
For zeile = 1 To .CountOfLines
If Trim(.Lines(zeile, 1)) <> "" Then zaehler = zaehler + 1
Next
If zaehler > 1 Then
Print #1, VBEobj.Name & ":"
Leerzeile 2
For zeile = 1 To .CountOfLines
If Trim(.Lines(zeile, 1)) <> "" Then Print #1, .Lines(zeile, 1)
Next
Leerzeile 3
End If
End With
Next
Print #1, "Verweise:"
Leerzeile 2
Set VBEobj = Datei.VBProject.References
For Each item In VBEobj
Print #1, item.Description
Next
Leerzeile 3
Print #1, String(200, "-")
Leerzeile 3
Close #1
End Sub
Private Sub Leerzeile(Anzahl As Integer)
Dim zeile As Integer
For zeile = 1 To Anzahl
Print #1, ""
Next
End Sub

Bild

Betrifft: AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
von: EL
Geschrieben am: 25.09.2003 10:21:06
Hallo Nepumuk!
Ich habe diese Code in eine meine Projekte Probiert.
Es Funktioniert.
Nun 465 KB ist die text datei groß.
Es handelt sich um eine Arbeitsmappe.
Ich hab gefunden das manche Makros werden nicht mehr gebraucht und andere könnte ich verbesseren.
Gibt es die Möglichkeit das ich die Änderungen in Word oder editor machen und das Alte Projekt Löschen und Neu Projekt zurück in Excel importieren,
Gruß
EL
Bild

Betrifft: AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
von: Nepumuk
Geschrieben am: 25.09.2003 17:25:21
Hallo El,
das wird aber unheimlich kompliziert und du hast beim editieren nicht die Syntaxüberprüfung die dir der VBA-Editor bietet. Das heißt, beim kleinstem Schreibfehler funktioniert dein Programm nicht mehr. Daher ist es auf alle Fälle besser diese Änderungen in Excel selbst zu machen. Aber wenn du es unbedingt haben willst, dann melde dich noch mal.
Gruß
Nepumuk
Bild

Betrifft: AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
von: EL
Geschrieben am: 25.09.2003 20:40:30
Hallo Nepumuk,
Ich sichere mein Programm vor her falls was schif geht, auserdem habe ich copien auf mehrere CD.Diese Tabelle ist 1,7 MB und ist nur Eine Platform und enthält formeln und Makros und Konstanten, und mächte es unter 1MB machen.
Das Text datei ist 527 seiten,ich habe es gedruckt und analisiert.
Falls für dich kein aufwand werde ich es versuchen!
Vielen Dank in voraus.
Gruß
EL
Bild

Betrifft: AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
von: Nepumuk
Geschrieben am: 25.09.2003 20:53:43
Hallo El,
das dauert aber länger. Schreib mir mal eine E-Mail (kaffl-nuernberg@t-online.de), damit ich deine Adresse habe. Ich melde mich dann, wenn ich damit fertig bin.
Gruß
Nepumuk
 Bild
Excel-Beispiele zum Thema " Makros aus allen XLS u. XLA-Dateien in Textdatei "
Start des Makros nach Laden der Arbeitsmappe Makros in Abhängigkeit vom Zellennamen aufrufen
Makros zeitgesteuert aufrufen CommandBar in Abhängigkeit vorhandener Makros erstellen
Makrostart bei Auswahl einer Zelle in Zeile 3 Makros aus einem Standardmodul in ComboBox einlesen
400 leere Textdateien anlegen Daten aus Textdatei gezielt in Zellen übernehmen
Textdatei als externe Datei per VBA einbinden Textdatei mit vorgegebenen Feldlängen anlegen