Hallo Rainer,
das kann ich verstehen, wunder mich wie gesagt schon die ganze Zeit wie du den Überblick behälst 
Private Declare Function PathFileExists Lib „shlwapi.dll“ Alias „PathFileExistsA“ (ByVal pszPath As String) As Long
Dim objRS As ADODB.Recordset
Dim objConnection As ADODB.Connection
Dim Feld() As String
Dim Pfd() As String
Private Sub Start_Click()
Dim i As Integer
e = Forms!SDS!Ex1 'Textfeld für Exception
d = Forms!SDS!Ex2 'Textfeld für Exception
r = Forms!SDS!Ex3 'Textfeld für Exception
If IsNull(Me.Ex1) Then 'Geprüft ob Textfeld null is
e = leer
End If
If IsNull(Me.Ex2) Then 'Geprüft ob Textfeld null is
d = leer
End If
If IsNull(Me.Ex3) Then 'Geprüft ob Textfeld null is
r = leer
End If
OpenDB
strSQL = „SELECT [Sds-task].* FROM [Sds-task]“
OpenRS strSQL
Transfer „c:\server1\sds-task.lst“ 'Standort von .lst Datei
Transfer „c:\server2\sds-task.lst“
Transfer „c:\server3\sds-task.lst“
Transfer „c:\server4\sds-task.lst“
objRS.Close
strSQL = „SELECT DISTINCT [Sds-task].[SDS-Typ], [Sds-task].[SDS-Name], [Sds-task].[CDS-ID], [Sds-task].Datum From [Sds-task] WHERE ((([Sds-task].[SDS-Typ]) Like ‚allusers‘));“
OpenRS strSQL
objRS.MoveFirst
ReDim Pfd(i)
While objRS.EOF = False
If objRS(„SDS-Name“) e And objRS(„SDS-Name“) d And objRS(„SDS-Name“) r Then 'Exception von SDS-Load
ReDim Preserve Pfd(i)
Pfd(i) = objRS(„SDS-Name“)
i = i + 1
End If
objRS.MoveNext
Wend
objRS.Close
objConnection.Close
Sync
End Sub
Private Sub Transfer(ByVal Datei As String)
Dim ff As Integer, Zl As String
Dim Fld() As String, i As Integer
ff = FreeFile
Open Datei For Input As #ff
While Not EOF(ff)
Line Input #ff, Zl
Fld = Split(Zl, " „)
objRS.AddNew
For i = 0 To 3
objRS(i) = Replace(Fld(i), „““", „“)
Next
objRS.Update
Wend
Close #ff
End Sub
Private Sub OpenDB() ’ Öffnen der DB
Dim strSQL As String
Dim DB As String
DB = „c:\SDS.mdb“
Set objConnection = New ADODB.Connection
With objConnection
.CursorLocation = adUseClient
.Mode = adModeShareDenyNone
.Provider = „Microsoft.Jet.OLEDB.4.0“
.ConnectionString = DB
.Open
End With
End Sub
Private Sub OpenRS(ByVal strSQL As String) ’ Öffnen des Datensatzes
Set objRS = New ADODB.Recordset
With objRS
Set .ActiveConnection = objConnection
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Source = strSQL
Call .Open
End With
End Sub
Private Sub QuickSort(ByVal LB As Long, ByVal UB As Long)
Dim P1 As Long, P2 As Long, Ref As String, TEMP As String
P1 = LB
P2 = UB
Ref = Feld((P1 + P2) / 2)
Do
Do While (Feld(P1) Ref)
P2 = P2 - 1
Loop
If P1 P2)
If LB Zl Then
Tmp(n) = Feld(i)
n = n + 1
Zl = Feld(i)
End If
Next
ReDim Feld(n - 1)
For i = 0 To n - 1
Feld(i) = Tmp(i)
Next
End Sub
Private Sub Repair() 'Verhindert das zwei Datensätze in einer Zeile stehen beim .yes File
Dim i As Long, Pos As Integer, Zl As String
For i = LBound(Feld) To UBound(Feld)
Zl = Feld(i)
Pos = InStr(1, Feld(i), „“"""")
If Pos 0 Then
Feld(i) = Left(Zl, Pos)
ReDim Preserve Feld(UBound(Feld) + 1)
Feld(UBound(Feld)) = Right(Zl, Len(Zl) - Pos)
End If
Next
End Sub
Private Sub Sync() ’ Synchronisiert die .yes Files von den verschiedenen Servern
Dim Txt As String, Daten As String
Dim i As Integer, c As Integer, ff As Integer, l As Long
Dim Server(3) As String, Pfad As String, Pos As Integer
Server(0) = „c:\server1\Daten“ 'Standort von .yes Files
Server(1) = „c:\server2\Daten“
Server(2) = „c:\server3\Daten“
Server(3) = „c:\server4\Daten“
ff = FreeFile
For i = LBound(Pfd) To UBound(Pfd)
Daten = „“
For c = 0 To 3
Pfad = Server© + Pfd(i) + „.yes“
If PathFileExists(Pfad) Then
l = FileLen(Pfad)
Txt = Space(l)
Open Pfad For Binary As #ff
Get #ff, , Txt
Close #ff
Daten = Daten + Txt
End If
Next
If Trim(Daten) „“ Then
Feld = Split(Daten, vbCrLf)
Repair
QuickSort LBound(Feld), UBound(Feld)
Clean
Daten = Join(Feld, vbCrLf)
For c = 0 To 3
Pfad = Server© + Pfd(i) + „.yes“
Open Pfad For Output As #ff
Print #ff, Daten
Close #ff
Next
End If
Next
End Sub
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
