Thema Datum  Von Nutzer Rating
Antwort
18.06.2018 10:48:29 FS
NotSolved
Blau Do Until-Schleife
 18.06.2018 15:51:58 FS
NotSolved
19.06.2018 12:01:30 Gast76111
NotSolved
20.06.2018 08:54:54 Gast21364
NotSolved

Ansicht des Beitrags:
Von:
FS		 Datum:
18.06.2018 15:51:58		 Views:
645		 Rating:
     
Antwort:
  Ja
Thema:
Do Until-Schleife
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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) =

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
18.06.2018 10:48:29 FS
NotSolved
Blau Do Until-Schleife
 18.06.2018 15:51:58 FS
NotSolved
19.06.2018 12:01:30 Gast76111
NotSolved
20.06.2018 08:54:54 Gast21364
NotSolved