Public Sub T_DELL()
' Organisation der Publikations - Datenbank T auf DELL
'12.3.11
Dim f
Dim fs 'File System Object
Dim Pfx
Dim Vid 'Rechner-ID
Dim Vy 'Entscheidungsvariable
Dim Vz 'Datensatz-Zeiger
Dim Vt 'Tiefe (\g\ = 1, \g\x\ = 2, \g\x\y\ = 3
Dim Vdir 'Dir - String
Dim Vst
Dim Dt, Dg 'Laufwerk von T\ bzw G\
Dim Da 'aktuelles Dir
Dim g_t 'aktueller Bereich: g = Graph, T = Text
g_t = "T"
Dim Dx1, dx1a, dx1b, dx2, dx2a, Vx, i
Dim DB As Database 'Database deklarieren
Dim DatRst As Recordset 'Recordset deklarieren
Dim DirRst As Recordset 'Hilfsdatei für Verzeichnisnamen
Set DB = CurrentDb 'aktuelle Database aktivieren
Set DirRst = DB.OpenRecordset("DirHilf", dbOpenDynaset)
Set DatRst = DB.OpenRecordset("T_Dell", dbOpenDynaset)
Set fs = CreateObject("Scripting.FileSystemObject") 'File - System Objekt aktivieren
Set dc = fs.Drives
Debug.Print "Analyse von \T auf DELL"
Debug.Print "---------------------", Date

' 1. Ordner
Vt = 1
Da = "D:\T" 'aktuelles Text-Dir
g_t = "t" 'Art des Verzeichnisses
Vy = 0 '9 = Ende
AnaDir Da, fs, DatRst, DirRst, g_t, Vt, Vy 'Dir analysieren
If Vy = 9 Then Exit Sub

' 2. Ordner
Vt = 2
'DirL DatRst, DirRst, Vt, g_t
DirRst.MoveFirst
Do While Not DirRst.EOF
If DirRst![Tiefe] = 1 Then
Da = DirRst![DirN] + "\" + DirRst![Name]
AnaDir Da, fs, DatRst, DirRst, g_t, Vt, Vy 'Dir analysieren
If Vy = 9 Then Exit Sub
End If
DirRst.MoveNext
Loop

' 3. Ordner
Vt = 3
'DirL DatRst, DirRst, Vt, g_t
DirRst.MoveFirst
Do While Not DirRst.EOF
If DirRst![Tiefe] = 2 Then
Da = DirRst![DirN] + "\" + DirRst![Name]
AnaDir Da, fs, DatRst, DirRst, g_t, Vt, Vy 'Dir analysieren
If Vy = 9 Then Exit Sub
End If
DirRst.MoveNext
Loop

' 4. Ordner
Vt = 4
'DirL DatRst, DirRst, Vt, g_t
DirRst.MoveFirst
Do While Not DirRst.EOF
If DirRst![Tiefe] = 3 Then
Da = DirRst![DirN] + "\" + DirRst![Name]
AnaDir Da, fs, DatRst, DirRst, g_t, Vt, Vy 'Dir analysieren
If Vy = 9 Then Exit Sub
End If
DirRst.MoveNext
Loop

' 5. Ordner
Vt = 5
'DirL DatRst, DirRst, Vt, g_t
DirRst.MoveFirst
Do While Not DirRst.EOF
If DirRst![Tiefe] = 4 Then
Da = DirRst![DirN] + "\" + DirRst![Name]
AnaDir Da, fs, DatRst, DirRst, g_t, Vt, Vy 'Dir analysieren
If Vy = 9 Then Exit Sub
End If
DirRst.MoveNext
Loop

' 6. Ordner
Vt = 6
'DirL DatRst, DirRst, Vt, g_t
DirRst.MoveFirst
Do While Not DirRst.EOF
If DirRst![Tiefe] = 5 Then
Da = DirRst![DirN] + "\" + DirRst![Name]
AnaDir Da, fs, DatRst, DirRst, g_t, Vt, Vy 'Dir analysieren
If Vy = 9 Then Exit Sub
End If
DirRst.MoveNext
Loop
Exit Sub

' 7. Ordner
Vt = 7
'DirL DatRst, DirRst, Vt, g_t
DirRst.MoveFirst
Do While Not DirRst.EOF
If DirRst![Tiefe] = 6 Then
Da = DirRst![DirN] + "\" + DirRst![Name]
AnaDir Da, fs, DatRst, DirRst, g_t, Vt, Vy 'Dir analysieren
If Vy = 9 Then Exit Sub
End If
DirRst.MoveNext
Loop 03.10.2014 10:24 DA2, Vt2, G_T1, Dir1)
'legt in RST einen neuen Datensatz für eine Datei oder ein Verzeichnis an
Debug.Print F2.Name
Debug.Print F2.Name, F2.Size, F2.Attributes, F2.Path, F2.ParentFolder
Debug.Print F2.DateCreated, F2.DateLastAccessed, F2.DateLastModified
Rst.AddNew
Rst![DatNeu] = Date
Rst![Update] = Date
Rst![Name] = F2.Name
Rst![Byte] = F2.Size
Rst![DirQuell] = F2.ParentFolder
Rst![DatKrea] = F2.DateCreated
Rst![DatAcc] = F2.DateLastAccessed
Rst![DatModi] = F2.DateLastModified
Rst![Attrib] = F2.Attributes
Rst![Tiefe] = Vt2
If Dir1 = "D" Then
Rst![Dir] = True
DirRst2.AddNew
DirRst2![Name] = F2.Name
DirRst2![Tiefe] = Vt2
DirRst2![DirN] = F2.ParentFolder
DirRst2.Update
Else
Rst![Dir] = False
End If
If G_T1 = "g" Then Rst![Graph] = True
If G_T1 = "t" Then Rst![Tex] = True
Rst.Update
End Sub

Public Sub FSuch(F1, Rst, G_T1, Dir1, Vy1, Vt2)
' FSuch f, DatRst, Vy
' existiert die Datei?
' Rst Datensatz,
' F1 Dateiname, Vy1 Antwort - Variable
' g_t1 Grafik oder Text Dir1: "D" Dir, "F" File
Rst.Index = "name" 'Index Dateiname wählen
Vy1 = False
Debug.Print "gesuchte Datei ", F1.Name, F1.ParentFolder
Vdir = F1.ParentFolder
Vst = F1.Name
Debug.Print Vst
Rst.Seek "=", Vst
Debug.Print "nicht gefunden:", Rst.NoMatch
If Rst.NoMatch Then
Debug.Print "Datei nicht gefunden ", Vst
Vy1 = False
Exit Sub
End If
Do While Not Rst.EOF
If Rst![Name] <> Vst Then
Debug.Print "Datei nicht gefunden 2 ", Vst
Vy1 = False
Exit Sub
ElseIf Rst![DirQuell] <> Vdir Then
Debug.Print "falsches Dir ", Rst![Name], Rst![DirQuell]
ElseIf Rst![Graph] = False And G_T1 = "G" Then
Debug.Print "Text-Datei aber Grafik gesucht ", Rst![Name], Rst![Graph], G_T1
ElseIf Rst![Graph] = True And G_T1 = "T" Then
Debug.Print "Grafik-Datei aber Text gesucht ", Rst![Name], Rst![Graph], G_T1
ElseIf Rst![Dir] = False And Dir1 = "D" Then
Debug.Print "Datei aber Dir gesucht ", Rst![Name], Rst![Dir], Dir1
ElseIf Rst![Dir] = True And Dir1 = "F" Then
Debug.Print "Dir aber Datei gesucht ", Rst![Name], Rst![Dir], Dir1
Else
Debug.Print "Datei gefunden ", Rst![Name], Rst![Byte]
Vy1 = True
Exit Do
End If
Rst.MoveNext
Loop
' Eintrag überprüfen
Rst.Edit
If Rst![Byte] <> F1.Size Then
Debug.Print "Größe falsch ", Rst![Name], Rst![Byte], F1.Size
Rst![Byte] = F1.Size
Else
Debug.Print "Größe richtig ", Rst![Name], Rst![Byte], F1.Size
End If
If Rst![DatKrea] <> F1.DateCreated Then
Debug.Print "Datum Erzeugung falsch ", Rst![Name], Rst![DatKrea], F1.DateCreated
Rst![DatKrea] = F1.DateCreated
Else
Debug.Print "Datum Erzeugung richtig ", Rst![Name], Rst![DatKrea], F1.DateCreated
End If
'If Rst![DatAcc] <> F1.DateLastAccessed Then
' nicht prüfen, da Vierenscanner alle Zugriffsdaten ändert
Debug.Print "Datum letzter Zugriff ", Rst![Name], Rst![DatAcc], F1.DateLastAccessed
'Rst![DatAcc] = F1.DateLastAccessed
'Else
'Debug.Print "Datum letzter Zugriff richtig", Rst![Name], Rst![DatAcc], F1.DateLastAccessed
'End If
If Rst![DatModi] <> F1.DateLastModified Then
Debug.Print "Datum letzte Änderung falsch ", Rst![Name], Rst![DatModi], F1.DateLastModified
Rst![DatModi] = F1.DateLastModified
Else
Debug.Print "Datum letzte Änderung richtig ", Rst![Name], Rst![DatModi], F1.DateLastModified
End If
Rst.Update
End Sub
Public Sub AnaDir(Da1, fs1, DatRst1, DirRst1, G_T1, Vt1, Vy1)
Debug.Print "aktuelles Dir ", Da1
'DirRst Hilfsverzeichnis mit Ordnernamen
Dim Vf
Set F1 = fs1.GetFolder(Da1) ' F1 = Ordner Da1
Set fc1 = F1.files ' Fc1 = Dateien in Ordner Da1
Set fc2 = F1.subfolders

For Each f In fc1
'Dateien im Ordner
'FSuch f, DatRst1, DirRst1, Da1, G_T1, "F", Vf, Vt1 'existiert die Datei im Verzeichnis?
'Vf Antwort - Variable
'Debug.Print "Endergebnis: ", f, Vf
'y = InputBox("Such " + f, "s = Stop")
'If y = "s" Then
'Vy1 = 9
'Exit Sub
'End If
If Not Vf Then ' Datei existiert nicht
FNeu f, DatRst1, DirRst1, Da1, Vt1, G_T1, "F" 'neuer Datensatz
Debug.Print "FNeu: Datei-Datensatz: ", f
End If
Next

For Each f In fc2
'Ordner im Ordner
'FSuch f, DatRst1, Da1, G_T1, "D", Vy1, Vt1 'existiert die Datei?
'Debug.Print "Endergebnis: ", f, Vy1
'y = InputBox("Such Dir " + f, "s = Stop")
'If y = "s" Then
'Exit Sub
'End If
If Not Vy1 Then FNeu f, DatRst1, DirRst1, Da1, Vt1, G_T1, "D"
'neuer Datensatz
Next

End Sub

Public Sub DirL(Dat, Di, Vt1, G_T1)
' DirL DatRst, DirRst
' erstellt Liste der Unterverzeichnisse
Dat.MoveLast 'Dateiende
If Di.RecordCount > 0 Then
'y = InputBox("Datei DirHilf nicht leer: " + Str(Di.RecordCount), "s = Stop")
If y = "s" Then
Exit Sub
End If
Di.MoveFirst
Do While Not Di.EOF And Di.RecordCount > 0
Di.MoveFirst
Di.Edit
Di.Delete
Loop
'y = InputBox("Datei DirHilf gelöscht: " + Str(Di.RecordCount), "s = Stop")
If y = "s" Then
Exit Sub
End If
End If
Dat.MoveFirst
Do While Not Dat.EOF
If Dat![Tiefe] <> (Vt1 - 1) Then
Debug.Print "falsche Tiefe", Dat![Name]
ElseIf Dat![Dir] = False Then
Debug.Print "kein Verzeichnis", Dat![Name]
ElseIf G_T1 = "g" And Dat![Graph] = False Then
Debug.Print "Graphik - Bereich aber nicht Graphik - Verzeichnis", Dat![Name]
ElseIf G_T1 = "t" And Dat![Tex] = False Then
Debug.Print "Text - Bereich aber nicht Text - Verzeichnis", Dat![Name]
Else
Di.AddNew
Di![DirN] = Dat![DirQuell]
Di![Name] = Dat![Name]
Di.Update
Debug.Print Dat![Name]
End If
Dat.MoveNext
Loop
End Sub