' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub removeCodeFromFiles()
Dim objWB As Workbook
Dim strPath As String, strFile As String
Dim lngCalc As Long
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
strPath = "E:\Temp" 'Verzeichnis - Anpassen!
strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
strFile = Dir(strPath & "*.xls*")
Do While strFile <> ""
Set objWB = Workbooks.Open(strPath & strFile)
deleteAllCodeAndModules objWB
objWB.Close True
strFile = Dir
Loop
ErrExit:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'removeCodeFromFiles'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Modul1"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
Set objWB = Nothing
End Sub
Private Sub deleteAllCodeAndModules(ByVal WBook As Workbook)
Dim objVBComp As Object
With WBook.VBProject
For Each objVBComp In .vbComponents
If objVBComp.Type = 100 Then
With .vbComponents(objVBComp.Name).CodeModule
.DeleteLines 1, .CountOfLines
End With
Else
.vbComponents.Remove objVBComp
End If
Next
End With
End Sub
