Beim Ausführen des Nachfolgenden Codes erhalte ich regelmässig einen Excel-Absturz. Gibt es irgend eine Möglichkeit zu lokalisieren, wo der Fehler liegt?
Die zu importierenden Files liegen im Ordner, wo die Datei abgespeichert ist aus der der Code ausgeführt wird. Die Endungen sind *.cls, *.bas
Vielen Dank für jeden Hinweis.
Gruss, Peter
Public Sub prcImport()
Dim objVBComponents As Object, strFilename As String
If FuObjFile Is Nothing Then Exit Sub 'überprüfen, ob weniger oder mehr als zwei Dateien _
offen
With Workbooks(FuObjFile.Name).VBProject 'FuObjFile ist ein Objekt
For Each objVBComponents In .VBComponents
Select Case objVBComponents.Type
Case 1, 2, 3
.VBComponents.Remove .VBComponents(objVBComponents.Name)
Case 100
With objVBComponents.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
strFilename = Dir$(ThisWorkbook.Path & "\" & "*.*")
Do While strFilename ""
If UCase$(Right$(strFilename, 4)) = ".BAS" Or _
UCase$(Right$(strFilename, 4)) = ".FRM" Or _
UCase$(Right$(strFilename, 4)) = ".CLS" Then
.VBComponents.Import ThisWorkbook.Path & "\" & strFilename
End If
strFilename = Dir$
Loop
On Error Resume Next
For Each objVBComponents In .VBComponents
If objVBComponents.Type = 2 Then
Err.Clear
If Left$(objVBComponents.Name, 17) = "DieseArbeitsmappe" Or _
Left$(objVBComponents.Name, 7) = "Tabelle" Or _
Left$(objVBComponents.Name, 8) = "Diagramm" Then
.VBComponents(Left$(objVBComponents.Name, Len(objVBComponents.Name) - 1)). _
_
CodeModule.InsertLines 1, objVBComponents.CodeModule.Lines( _
1, objVBComponents.CodeModule.CountOfLines)
If Err.Number = 0 Then
.VBComponents.Remove .VBComponents(objVBComponents.Name)
Else
Debug.Print objVBComponents.Name
End If
End If
End If
Next
End With
End Sub