DateienOeffnen_VBAObjImportieren

Sub OpenFiles()

Sub Import1()

Option Explicit

Public vbc As Object, iCounter As Integer, sMacro As String, cType As String, StDateiname As String
Public pfad As String, Dateiname As String, iRow As Long

Sub DateienOeffnen_VBAObjImportieren()
'Import des Gesamten VBA-Codes
'aus dem Verzeichnis C:\GB_Im-und_ExPort\Export\
'in alle im Verzeichnis
Const pfad = "C:\GB_Im-und_ExPort\Import\"
'vorhandenen Exceldateien *.xlsm
Application.EnableEvents = False
Application.ScreenUpdating = False
Dateiname = Dir$(pfad & "*.xlsm")
Do While Dateiname  ""
Workbooks.Open Filename:=pfad & Dateiname
ActiveWindow.WindowState = xlMinimized
With Workbooks(Dateiname).VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
StDateiname = Dir("C:\GB_Im-und_ExPort\Export\" & "*.*")
Do While StDateiname  ""
If UCase(Right(StDateiname, 4)) = ".BAS" Or UCase(Right(StDateiname, 4)) = ".FRM" _
_
_
_
Or UCase(Right(StDateiname, 4)) = ".CLS" Then
.VBComponents.Import "C:\GB_Im-und_ExPort\Export\" & StDateiname
End If
StDateiname = Dir
Loop
For Each vbc In .VBComponents
If vbc.Type = 2 Then
If Left(vbc.Name, 5) = "Diese" Or Left(vbc.Name, 7) = "Tabelle" Then
.VBComponents(Left(vbc.Name, Len(vbc.Name) - 1)).CodeModule.InsertLines 1, _
_
_
_
vbc.CodeModule.Lines(1, vbc.CodeModule.CountOfLines)
.VBComponents.Remove .VBComponents(vbc.Name)
End If
End If
Next vbc
End With
Workbooks(Dateiname).Save
Workbooks(Dateiname).Close
Dateiname = Dir$
Loop
Application.EnableEvents = True
End Sub