VB-Code with embedded SQL. As Python-like-highlight. How loo

Python code posted by gapsdv
created at 29 Oct 16:36

Edit | Back 
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
 
VB-Code with embedded SQL. As Python-like-highlight. How looks it? ;-)

Option Compare Database
Option Explicit

Function RezeptDateisuchen()
'08.10.2002 vd Filesearch hat bug

Dim strPfad, strDateiendung, strDateiname, strSQLKommando As String
Dim iZähler, iZähler2 As Integer

On Error GoTo Err_RezeptDateisuchen

strPfad = DLookup("[PfadDateien]", "Konfiguration", "[KonfigurationNr]=1")
strDateiendung = "asc"

strDateiname = Dir(strPfad + "*." + strDateiendung)
If strDateiname <> "" Then

    'Dateien zählen
    iZähler = 1
    While strDateiname <> ""
        iZähler = iZähler + 1
        strDateiname = Dir
    Wend
    
    'Reinitialisierung
    iZähler2 = iZähler
    iZähler = 1
    strDateiname = Dir(strPfad + "*." + strDateiendung)
    
    DoCmd.Echo True, "Tabellenliste aktualisieren"
    SQL_no_warning ("UPDATE TabelleXY SET DateiGelöscht = TRUE")
    
    Do
        If IsNull(DLookup("RezeptDatei", "TabelleXY", "DateiXY = '" & Left(strDateiname, Len(strDateiname) - 4) & "'")) Then
            SQL_no_warning ("INSERT INTO TabelleXY (DateiXY, Speicherdatum) VALUES ('" & Left(strDateiname, Len(strDateiname) - 4) & "', '" & FileDateTime(strPfad & strDateiname) & "')")
        Else
            SQL_no_warning ("UPDATE TabelleXY SET Speicherdatum =  '" & FileDateTime(strPfad & strDateiname) & "' WHERE DateiXY = '" & Left(strDateiname, Len(strDateiname) - 4) & "'")
        End If
        'Flag für löschen entfernen
        SQL_no_warning ("UPDATE TabelleXY SET DateiGelöscht = FALSE" & " WHERE DateiXY = '" & Left(strDateiname, Len(strDateiname) - 4) & "'")

        'naechster Dateiname
        strDateiname = Dir
        
        iZähler = iZähler + 1
        Status iZähler / iZähler2 * 100, iZähler & ". XY einlesen von " & iZähler2
        
    Loop Until strDateiname = ""

 .... more code
1.83 KB in 5 ms with coderay