VBA-Module per VBA in Textdatei übernehmen

07/07/2009 - 08:48 von HelmutMit | Report spam
Hallo,
ich suche nach einer Möglichkeit, die VBA-Prozeduren einer Datei
automatisch in eine Textdatei zu schreiben.
Dazu möchte ich nicht jeden Modul einzeln aufrufen müssen, sondern das
soll automatisch funktionieren, also in der Art ".. for each.. in.."
Wàre schön, wenn jemand helfen könnte!
Gruß Helmut
 

Lesen sie die antworten

#1 Andreas Killer
07/07/2009 - 09:05 | Warnen spam
On 7 Jul., 08:48, HelmutMit wrote:

ich suche nach einer Möglichkeit, die VBA-Prozeduren einer Datei
automatisch in eine Textdatei zu schreiben.



'VBProject.VBComponents.Type:
Enum vbCompType
vbCompTypeModul = 1 'normales Modul
vbCompTypeClassModul = 2 'Klassenmodul
vbCompTypeUserform = 3 'Userform
vbCompTypeSheet = 100 'Codemodul einer Tabelle
End Enum

Sub VBAexportieren(Optional ByVal Pfad As String = "", _
Optional ByVal WorkBookName As String = "*", _
Optional ByVal Modulname As String = "*", _
Optional Overwrite As Boolean = False)
'Exportiert alle Module des gewünschten Namens aller geöffenten _
Arbeitsmappen als .bas/.frm
Dim Wb As Workbook, vbComp As Object, fs As Object, F As Object
Dim i As Long, FName As String

If Pfad = "" Then Pfad = ActiveWorkbook.Path
'Alle geöffneten Mappen durchlaufen
For Each Wb In Workbooks
If Wb.Name Like WorkBookName Then
'Alle VBA-Komponenten durchlaufen
For Each vbComp In Wb.VBProject.VBComponents
With vbComp.codemodule
'Ist dies Modul eines der gewünschten?
FName = .Name
If .Name Like Modulname Then
Select Case vbComp.Type
Case vbCompTypeUserform
FName = fs.GetAbsolutePathName(Pfad) & "\" & Wb _
.Name & "-" & vbComp.Type & "-" & .Name & ".frm"
If Not Overwrite Then
i = 1
'Wenn es diese Datei schon gibt, dann einen _
Namen mit einem Index generieren
Do While fs.FileExists(FName)
FName = fs.GetAbsolutePathName(Pfad) & "\" & _
Wb.Name & "-" & vbComp.Type & "-" & .Name & "("
& i & ").frm"
i = i + 1
Loop
End If
vbComp.Export FName
Case Else
If .CountOfLines > 0 Then
Set fs = CreateObject( _
"Scripting.FileSystemObject")
'Ja, einen Dateinamen generieren
FName = fs.GetAbsolutePathName(Pfad) & "\" & Wb _
.Name & "-" & vbComp.Type & "-" & .Name & ".bas"
If Not Overwrite Then
i = 1
'Wenn es diese Datei schon gibt, dann einen _
Namen mit einem Index generieren
Do While fs.FileExists(FName)
FName = fs.GetAbsolutePathName(Pfad) & "\" _
& Wb.Name & "-" & .Name & "(" & i & ").bas"
i = i + 1
Loop
End If
vbComp.Export FName
End If
End Select
End If
End With
Next
End If
Next
End Sub

Ähnliche fragen