VBA Fehlermeldung

Private Sub CheckFiles(line As Long, fdr As Folder, level As Integer)
Dim xmlph As String, i As itsCwType, needsToBeChecked As Boolean, lsninf As cLessonInfo
Dim hasFile(16) As File, isAllowed(16) As Boolean, isRequired(16) As Boolean, needsCheck(16) _
_
As Boolean
For i = 1 To 16
Set hasFile(i) = Nothing
isAllowed(i) = False
isRequired(i) = False
needsCheck(i) = False
Next i
isAllowed(itsCwTypeThumbsDb) = True
isAllowed(itsCwTypeToDo) = True
isAllowed(itsCwTypeRedaktion) = True
isRequired(itsCwTypeDataXML) = True
Select Case level
Case itsCwLevelCourse ' course
isRequired(itsCwTypeCatalog) = True
needsCheck(itsCwTypeCatalog) = True
isAllowed(itsCwTypeListe) = True
Case itsCwLevelSubject ' subject
Case itsCwLevelTopic ' topic
Case itsCwLevelLesson ' lesson
isRequired(itsCwTypeManual) = True
needsCheck(itsCwTypeManual) = True
isRequired(itsCwTypePowerPoint) = True
needsCheck(itsCwTypePowerPoint) = True
isRequired(itsCwTypeLessonSummary) = True
needsCheck(itsCwTypeLessonSummary) = True
isAllowed(itsCwTypeTestQuestions) = True
needsCheck(itsCwTypeTestQuestions) = True
isAllowed(itsCwTypeTestSolution) = True
needsCheck(itsCwTypeTestSolution) = True
isAllowed(itsCwTypeWorksheetTask) = True
needsCheck(itsCwTypeWorksheetTask) = True
isAllowed(itsCwTypeWorksheetSolution) = True
needsCheck(itsCwTypeWorksheetSolution) = True
isAllowed(itsCwTypeBildliste) = True
needsCheck(itsCwTypeBildliste) = False 'Bildliste prüfen  _
ausgeschaltet
End Select
For i = 1 To 16
If isRequired(i) = True Then
isAllowed(i) = True
End If
Next i
Dim currXMLData As cXMLData
xmlph = FindXMLFile(fdr)
If xmlph  "" Then
Select Case level
Case itsCwLevelCourse
pCrsXMLData.OpenFile xmlph
Set currXMLData = pCrsXMLData
Case itsCwLevelSubject
pSbjXMLData.OpenFile xmlph
Set currXMLData = pSbjXMLData
Case itsCwLevelTopic
pTpcXMLData.OpenFile xmlph
Set currXMLData = pTpcXMLData
Case itsCwLevelLesson
pLsnXMLData.OpenFile xmlph
Set currXMLData = pLsnXMLData
Case Else
Set currXMLData = Nothing
End Select
End If
Set lsninf = New cLessonInfo
lsninf.FromString fdr.Name
DocInfo.SuNr = lsninf.SuNr
DocInfo.ToNr = lsninf.ToNr
DocInfo.LeNr = lsninf.LeNr
Dim docs As files, sdoc As File
Dim dinf As cDocumentInfo, pgs As Long
Dim finf As cFileinfo, ninfos As Long, nproblems As Long
Dim pgsval As Variant, pgsfrm As Variant, colnr As Integer
Set dinf = New cDocumentInfo
Set docs = fdr.files
For Each sdoc In docs
dinf.FromFileName sdoc.Name
If dinf.IsOwnerFile = False And dinf.TypeEnum  itsCwTypeThumbsDb Then
'Debug.Print "File: " & sdoc.Name
If isAllowed(dinf.TypeEnum) = True Then
If Not hasFile(dinf.TypeEnum) Is Nothing Then
AddError sdoc.path, "Mehrere Dateien vom gleichen Typ", False,  _
errorColorOrange
Else
Set hasFile(dinf.TypeEnum) = sdoc
End If
Else
AddError sdoc.path, "Unzulässige Datei", False, errorColorOrange
End If
End If
Next sdoc
For i = 1 To 16
needsToBeChecked = False
If isRequired(i) = True And hasFile(i) Is Nothing Then
AddError fdr.path, "Fehlende Datei " & dinf.GetTypeName(i), False, errorColorOrange
End If
If Not hasFile(i) Is Nothing Then
pgs = 0
If Not currXMLData Is Nothing Then
If (i = itsCwTypeDataXML) And (Not currXMLData.DocInfo.IsSameLessonAs(DocInfo))  _
_
Then
Dim ddi As cDocumentInfo
Set ddi = currXMLData.DocInfo
'Debug.Print "old: " & ddi.ToFileName & "  new: " & DocInfo.ToFileName
ddi.CopyFrom DocInfo
Set currXMLData.DocInfo = ddi
currXMLData.SaveFile
End If
Set finf = currXMLData.GetFileInfoByType(dinf.GetTypeString(i))
If finf Is Nothing Then
ninfos = 0
nproblems = 0
pgs = 1
If needsCheck(i) = True Then
AddError hasFile(i).path, dinf.GetTypeName(i) & "wurde nicht geprüft",   _
_
True, errorColorOrange
needsToBeChecked = True
End If
Else
ninfos = currXMLData.GetFileInfosByType(dinf.GetTypeString(i))
nproblems = currXMLData.GetFileProblemsByType(dinf.GetTypeString(i))
Dim fidate As Date, xmdate As Date, chdate As Date, forcerev As String
fidate = hasFile(i).DateLastModified
xmdate = finf.Changed
chdate = finf.Checked
If i  itsCwTypePowerPoint Then
forcerev = currXMLData.ForceRevdate
Else
forcerev = ""
End If
If (ninfos > 0) Or (nproblems > 0) Or (fidate > chdate) Or (forcerev  "")  _
_
Or (pCatalogWasChanged = True) Then
Dim errstr As String, col As ErrorColor
errstr = ""
col = errorColorOrange
If (ninfos > 0) Or (nproblems > 0) Then
errstr = "hat beim Prüfen"
If (nproblems = 1) Then
errstr = errstr & " ein Problem"
End If
If (nproblems > 1) Then
errstr = errstr & " " & nproblems & " Probleme"
End If
If (ninfos > 0) And (nproblems > 0) Then
errstr = errstr & " und"
End If
If (ninfos = 1) Then
errstr = errstr & " einen Hinweis"
End If
If (ninfos > 1) Then
errstr = errstr & " " & ninfos & " Hinweise"
End If
errstr = errstr & " ergeben"
If (ninfos > 0) Then col = errorColorGreen
If (nproblems > 0) Then col = errorColorRed
End If
If (fidate > chdate) Then
If errstr  "" Then
errstr = errstr & " und "
End If
errstr = errstr & "wurde nach dem Prüfen verändert (" &  _
FormatTimeSpan(fidate, chdate) & ")"
End If
If (forcerev  "") Then
If errstr  "" Then
errstr = errstr & " und "
End If
errstr = errstr & "das Revisionsdatum muss geändert werden (" &  _
forcerev & ")"
End If
If (pCatalogWasChanged = True) Then
If errstr  "" Then
errstr = errstr & " und "
End If
errstr = errstr & "der Katalog wurde verändert"
End If
AddError hasFile(i).path, errstr, True, col
needsToBeChecked = True
End If
If needsCheck(i) = True Then
pgs = finf.Pages
Else
pgs = 1
End If
End If
Else
If needsCheck(i) = True Then
AddError hasFile(i).path, dinf.GetTypeName(i) & "wurde noch nicht geprüft",  _
_
True, errorColorOrange
pgs = 0
needsToBeChecked = True
End If
If i = itsCwTypeToDo Then
pgs = 1
End If
End If
If pgs  0 And i  itsCwTypeDataXML And i  itsCwTypeCatalog And i   _
itsCwTypeListe Then
colnr = dinf.GetColumnNumber(i)
pgsval = Application.Sheets(syllabus).Cells(line, colnr).Value
pgsfrm = Application.Sheets(syllabus).Cells(line, colnr).Formula
If pgsval = 0 And pgsfrm = "" Then
Application.Sheets(syllabus).Cells(line, colnr).Value = pgs
Application.Sheets(syllabus).Hyperlinks.Add Anchor:=Application.Sheets( _
syllabus).Cells(line, colnr), _
Address:="file:///" & hasFile(i) _
_
.path, _
ScreenTip:=hasFile(i).Name, _
TextToDisplay:="" & pgs
Application.Sheets(syllabus).Cells(line, colnr).Font.Underline =  _
xlUnderlineStyleNone
Application.Sheets(syllabus).Cells(line, colnr).Font.Color = RGB(0, 51,  _
153)
Else
If Left$(pgsfrm, 1)  "=" Then
AddHighlight line, colnr, True, RGB(255, 0, 0), RGB(255, 255, 127)
Application.Sheets(syllabus).Cells(line, colnr).Value = pgs
Else
AddHighlight line, colnr, True, RGB(127, 0, 0), RGB(255, 200, 0)
Application.Sheets(syllabus).Cells(line, colnr).Value = pgs + pgsval
Application.Sheets(syllabus).Cells(line, colnr).Formula = pgsfrm & "+" & _
_
pgs
End If
End If
If needsToBeChecked = True Then
With Application.Sheets(syllabus).Cells(line, colnr).Interior
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 192, 192)
.TintAndShade = 0
End With
End If
End If
If (i = itsCwTypeCatalog) And (needsToBeChecked = True) Then
pCatalogWasChanged = True
End If
End If
Next i
If level = itsCwLevelLesson And Not currXMLData Is Nothing Then
Application.Sheets(syllabus).Cells(line, 4).Value = currXMLData.PeriodsTheory
Application.Sheets(syllabus).Cells(line, 5).Value = currXMLData.PeriodsPractice
If currXMLData.GetTasksCount > 0 Then
Application.Sheets(syllabus).Cells(line, 13).Value = currXMLData.GetTasksCount
Else
Application.Sheets(syllabus).Cells(line, 13).Value = ""
End If
Application.Sheets(syllabus).Cells(line, 14).Value = currXMLData.Questions
Application.Sheets(syllabus).Cells(line, 19).Value = GetRevDate(currXMLData.Revdate)
End If
Dim fdrs As folders, sfdr As Folder
Set fdrs = fdr.subfolders
For Each sfdr In fdrs
Next sfdr
End Sub