Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
312to316
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
312to316
312to316
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makros aus allen XLS u. XLA-Dateien in Textdatei

Makros aus allen XLS u. XLA-Dateien in Textdatei
23.09.2003 16:34:00
Reinhard
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

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
23.09.2003 19:45:41
Nepumuk
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
Anzeige
Danke dir, melde mich ob es bei mir klappt o.w.T
23.09.2003 20:23:40
Reinhard
o.w.T.=ohne weiteren Text :-)
klappt nicht :-( Laufzeitfehler9, Index außerhalb
24.09.2003 12:01:35
Reinhard
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

Anzeige
AW: klappt nicht :-( Laufzeitfehler9, Index außerhalb
24.09.2003 17:01:37
Nepumuk
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
Anzeige
Danke dir, jetzt läuft es einigermaßen
25.09.2003 16:07:43
Reinhard
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

Anzeige
AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
25.09.2003 10:21:06
EL
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
AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
25.09.2003 17:25:21
Nepumuk
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
Anzeige
AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
25.09.2003 20:40:30
EL
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
AW: Makros aus allen XLS u. XLA-Dateien in Textdatei
25.09.2003 20:53:43
Nepumuk
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
Anzeige

129 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige