Konkret geht es darum, hier in die Do-Until-Schleife eine Bedingung einzufügen...


'******************************
Private Sub cmdProcess_Click()
'******************************
  Dim tMsg As String, tAnswer As Integer
   
  If Range("D3") = "A" Then
    tMsg = "Prüfung wird über alle Solvency-I-Buchungskreise durchgeführt!"
    tAnswer = MsgBox(tMsg, vbExclamation + vbOKCancel, "VV-Prüffung")
    If tAnswer = vbOK Then
      flagProcess = True
    Else
      flagProcess = False
    End If
  Else
    flagProcess = True
  End If
   
  If flagProcess Then
    Call doProcess1
  End If
   
End Sub

 'Übertragen der Verzeichnisnamen für die Buchungskreise in ein Array
  '  bis alle Verzeichnisse übernommen oder
  '  bei Verarbeitung eines einzelnen Buchungskreises das Verzeichnis im Zugriff
  Do Until tsVerzeichnisName = "" Or Left$(tsVerzeichnisName, 4) = tsBuchungskreis
     
    tsVerzeichnisName = Dir
    If tsVerzeichnisName <> "." And tsVerzeichnisName <> ".." Then
 
      'Bitweiser Vergleich
      If (GetAttr(tsRootDir & tsVerzeichnisName) And vbDirectory) = vbDirectory Then
        tiCounterDirectory = tiCounterDirectory + 1
 
        ReDim Preserve tVerzeichniseBuchungskreis(tiCounterDirectory)
        tVerzeichniseBuchungskreis(tiCounterDirectory) = tsVerzeichnisName
 
      End If
    End If
 
  Loop
   
  '16.02.09:jgr:ergänzt
  For i = 1 To tiCounterDirectory
    ActiveWorkbook.Worksheets("Log3").Cells(i + 1, 3) = tVerzeichniseBuchungskreis(i)
  Next i
 
  writeLog "Anzahl BK (Counter): ", CDbl(tiCounterDirectory)
  writeLog "Anzahl BK (UBound): ", UBound(tVerzeichniseBuchungskreis)
   
'**********
   
  ' = (1) ========================================
  ' Verarbeitung über die Anzahl der Buchungskreisverzeichnisse
  ' loop directory (Buchungskreise)
  For tiCounterDirectory = 1 To UBound(tVerzeichniseBuchungskreis)
     
    'Initialisierung
    tSummeBestand = 0
     
    'Vorgabewert Buchungskreis prüfen
    If VerarbeitungEinzelbuchungskreis Then
      tsBuchungskreis = Left(tsVerzeichnisName, 4)
    Else
      'der Buchungskreis steht als 4stelliger Code am Anfang des Verzeichnisnamen
      tsBuchungskreis = Left(tVerzeichniseBuchungskreis(tiCounterDirectory), 4)
 
      tsVerzeichnisName = tVerzeichniseBuchungskreis(tiCounterDirectory)
    End If
      
    'Prüfen, ob Buchungskreis überhaupt DV-Verzeichnisse hat
    tsWorkDir = tsRootDir & tsVerzeichnisName & "\"
     
    tiCounterReport = 0
     
    tsReportName = Dir(tsWorkDir, vbDirectory)
      
    ' = (2/1) ========================================
    ' liest alle Report-/Dateinamen für den Buchungkskreis (innerhalb des Verzeichnisses) in ein Array
    ' loop files (Excel-Report Dateien)
    Do While tsReportName <> ""
       
      tsReportName = Dir
      If Left(tsReportName, 9) = "REPORT_VV" And Right(tsReportName, 12) = tDatum & cSuffix Then
        tiCounterReport = tiCounterReport + 1
        ReDim Preserve tExcelReports(tiCounterReport)
        tExcelReports(tiCounterReport) = tsReportName
      End If
       
      '16.02.09:jgr:ergänzt
      For i = 1 To tiCounterReport
        ActiveWorkbook.Worksheets("Log3").Cells(i + 1, 4) = tExcelReports(i)
      Next i
    Loop  ' = (2/1) =