Hallo Rainer,
Bier ist auch nicht mein Ding 
Also dieses:
From [Sds-task] WHERE „((([Sds-task].[SDS-Typ]) Like „„allusers““));“
ist neu von DIR hinzu gekommen, hab diesmal nix gemacht und Ausführungszeichen hatte ich auch schon versucht, aber die Zeile bleibt rot…
Wenn ich die Äußeren " entferne kommt die Meldung, Where erwartet Ausführungszeichen.
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hi Gerd,
From [Sds-task] WHERE „((([Sds-task].[SDS-Typ]) Like
„„allusers““));“
ist neu von DIR hinzu gekommen,
??? Fehler beim Kopieren?
Da steht immer noch:
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‘));“
in einer Zeile. Eine Zeile, die mit ‚WHERE …‘ anfängt gibt es nicht.
hab diesmal nix gemacht und
Ausführungszeichen hatte ich auch schon versucht, aber die
Zeile bleibt rot…
Wenn ich die Äußeren " entferne kommt die Meldung, Where
erwartet Ausführungszeichen.
Geh noch mal zu dem Code mit der Prozedur, scheinbar ist Dir nur beim Kopieren etwas schief gelaufen.
Gruß Rainer
Hallo Rainer,
jaaaaaaaaaaaa es lebt! Die Liste ist gefüllt mit den Dateinamen!
Es lag daran, dass wenn ich den Code Kopiere, dort zwei Zeilen draus gemacht werden und dann die Ausführungszeichen autom. gesetzt werden von Access…Sorry, mal wieder mein Fehler!
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hallo Gerd,
jaaaaaaaaaaaa es lebt! Die Liste ist gefüllt mit den
Dateinamen!Es lag daran, dass wenn ich den Code Kopiere, dort zwei Zeilen
draus gemacht werden und dann die Ausführungszeichen autom.
gesetzt werden von Access…Sorry, mal wieder mein Fehler!
nein, den Fehler hat Access gemacht.
OK, wenn das geht, dann können wir uns ja mal trauen, die Testdaten anzufassen. Das fertige Programm!
Vorsicht, noch nicht auf den Server loslassen, erst testen, das Programm schreibt schon!
Gruß Rainer
Dim objRS As ADODB.Recordset
Dim objConnection As ADODB.Connection
Dim Feld() As String
Dim Pfd(45) As String
Private Sub Befehl0\_Click()
Dim i As Integer
OpenDB
strSQL = "SELECT [Sds-task].\* FROM [Sds-task]"
OpenRS strSQL
Transfer "c:\server1\sds-task.lst"
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
While objRS.EOF = False
Pfd(i) = objRS("SDS-Name")
i = i + 1
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()
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)
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 Sync()
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
Server(0) = "c:\Server1\"
Server(1) = "c:\Server2\"
Server(2) = "c:\Server3\"
Server(3) = "c:\Server4\"
ff = FreeFile
For i = LBound(Pfd) To UBound(Pfd)
Daten = ""
For c = 0 To 3
Pfad = Server(c) + Pfd(i)
l = FileLen(Pfad)
Txt = Space(l)
Open Pfad For Binary As #ff
Get #ff, , Txt
Close #ff
Daten = Daten + Txt
Next
Feld = Split(Daten, vbCrLf)
QuickSort Feld(LBound(Feld), UBound(Feld))
Clean
Daten = Join(Feld, vbCrLf)
For c = 0 To 3
Pfad = Server(c) + Pfd(i)
Open Pfad For Output As #ff
Print #ff, Daten
Close #ff
Next
Next
End Sub
Hallo Rainer,
Code kopiert und gestartet, bleibt bei:
QuickSort Feld(LBound(Feld), UBound(Feld)) mit der Meldung:
„Argument ist nicht optional“
Glaube diese Meldung hatten wir schon mal zu Anfang, kann sie aber im Moment nicht zuordnen…
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hallo Rainer,
habe nochmal die Daten überprüft, an denen kann es aber nicht liegen…hmmm, VBA ist echt nicht einfach.
Machen wir morgen weiter? Ich DANKE Dir nochmal für die Hilfe und
wenn es wirklich nur noch diese Hürde ist, können wir vielleicht morgen schon fertig sein.
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hallo Gerd,
Code kopiert und gestartet, bleibt bei:
QuickSort Feld(LBound(Feld), UBound(Feld)) mit der Meldung:
„Argument ist nicht optional“Glaube diese Meldung hatten wir schon mal zu Anfang, kann sie
aber im Moment nicht zuordnen…
das war zwischendurch und ich habe vermutet, daß das daran hängt, daß keine Daten da sind. das kann ja jetzt nicht mehr sein …
Da habe ich mich mal wieder verschrieben. 
Quicksort will doch zwei Parameter, ich übergebe einen und dann gebe ich für ein eindimensionales Feld auch noch zwei dimensionen an …
Das muss richtig so heißen:
QuickSort LBound(Feld), UBound(Feld)
Gruß Rainer
Hi gerd,
habe nochmal die Daten überprüft, an denen kann es aber nicht
liegen…
ja, mein Fehler.
Machen wir morgen weiter?
Einverstanden. Ich bin hier noch nicht ganz fertig … Das Programm, das unsere Rechnungen druckt muss geändert werden, Portugal hat die Umsatzsteuer von 21% auf 20% gesenkt … Nur mal so am Rande, was ich hier sonst so treibe.
Gruß Rainer
Guten Morgen Rainer!
Bin schon fleißig am testen, es gibt noch Probleme, aber ich brauche noch etwas um sie klar zu fassen.
Ach du machst diese Programmierung von Beruf aus…kein Wunder
Gruss
Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hallo Rainer,
so ich musste erstmal die „alten Daten“ verschwinden lassen, um eine Aussage treffen zu können. Die Tabelle und Wertliste war noch mit alten Daten gefüllt.
Bei Private Sub Sync() gibt es in der Zeile Pfad = Server© + Pfd(i) die Meldung: „Datei nicht gefunden“
Wenn ich mit der Maus über diese Zeile gehe, zeigt er mir c:\Server1\ an, aber müsste dahinter nicht noch der Dateiname stehen?
Gruss
Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Moin Gerd,
Bin schon fleißig am testen, es gibt noch Probleme, aber ich
brauche noch etwas um sie klar zu fassen.
Na dann, ich bin wieder fit.
Ach du machst diese Programmierung von Beruf aus…kein
Wunder
… Aber nicht in einer Programmiersprache, deren Namen hier Jemand kennt. (SEVAG - S iemens E ingabe, V erarbeitungs- und A usgabe G enerator)
Gruß Rainer
Hi Gerd,
Bei Private Sub Sync() gibt es in der Zeile Pfad = Server© +
Pfd(i) die Meldung: „Datei nicht gefunden“Wenn ich mit der Maus über diese Zeile gehe, zeigt er mir
c:\Server1\ an, aber müsste dahinter nicht noch der Dateiname
stehen?
Ja. Welchen Inhalt hat ‚i‘ in dem Moment? Und welchen Inhalt hat Pfd(i)?
Wenn Du beim Test nicht richtig gezählt hast und Du bekommst wenieger als die erwarteten 46 Dateinamen zurück, tritt dieser Fehler auf.
Den habe ich absichtlich nicht abgefangen, weil Du ja gesagt hast, es müssen genau 46 Pfade sein.
Gruß Rainer
Hallo Rainer,
verstehe, daran wird es auch liegen! In diesem Beispiel hatte ich 46 Dateinamen, es können aber morgen auch weniger oder mehr sein…
Hatte in die Datei so geändert, das ich Momentan nur eine Datei habe, damit ich genau sehe, ob die Daten syncronisiert werden. Können wir das Abfangen, vielleicht durch die Abfrage? Dort wird nämlich die genaue Anzahl der Datenmenge angezeigt (in diesem Fall einer).
Siemens…hmmm, da kenne ich nur diese Geräte um Maschinen zu programmieren (kann es aber selbst nicht).
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hi Gerd,
verstehe, daran wird es auch liegen! In diesem Beispiel hatte
ich 46 Dateinamen, es können aber morgen auch weniger oder
mehr sein…
ahhhh, mit einer variablen Anzahl Dateien ist das etwas völlig anderes … Auch wenn sich nur zwei Zeilen ändern.
Da steht oben in Code:
Dim Pfd(45) As String
daraus wird:
Dim Pfd() As String
Und an der Stelle:
objRS.MoveFirst
While objRS.EOF = False
Pfd(i) = objRS("SDS-Name")
i = i + 1
objRS.Movenext
Wend
fügen wir zwei Zeilen ein:
objRS.MoveFirst
ReDim Pfd(i)
While objRS.EOF = False
ReDim Preserve Pfd(i)
Pfd(i) = objRS("SDS-Name")
i = i + 1
objRS.Movenext
Wend
Nun werden immer so viele Programme verarbeitet, wie Pfade gefunden werden.
Voch mal der gesamte Code, nur zur Sicherheit um Missverständnisse zu vermeiden:
Dim objRS As ADODB.Recordset
Dim objConnection As ADODB.Connection
Dim Feld() As String
Dim Pfd() As String
Private Sub Befehl0\_Click()
Dim i As Integer
OpenDB
strSQL = "SELECT [Sds-task].\* FROM [Sds-task]"
OpenRS strSQL
Transfer "c:\server1\sds-task.lst"
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
ReDim Preserve Pfd(i)
Pfd(i) = objRS("SDS-Name")
i = i + 1
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()
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)
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 Sync()
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
Server(0) = "c:\Server1\"
Server(1) = "c:\Server2\"
Server(2) = "c:\Server3\"
Server(3) = "c:\Server4\"
ff = FreeFile
For i = LBound(Pfd) To UBound(Pfd)
Daten = ""
For c = 0 To 3
Pfad = Server(c) + Pfd(i)
l = FileLen(Pfad)
Txt = Space(l)
Open Pfad For Binary As #ff
Get #ff, , Txt
Close #ff
Daten = Daten + Txt
Next
Feld = Split(Daten, vbCrLf)
QuickSort LBound(Feld), UBound(Feld)
Clean
Daten = Join(Feld, vbCrLf)
For c = 0 To 3
Pfad = Server(c) + Pfd(i)
Open Pfad For Output As #ff
Print #ff, Daten
Close #ff
Next
Next
End Sub
Ich hoffe, daß ich alle Korrekturen, die wir schon hatten in dem Code auch schon umgesetzt habe.
Gruß Rainer
Hallo Rainer,
du bist GENIAL! Es funktionierte auf anhieb-freu!!!
Können wir bitte noch abfangen (es geht jetzt nur noch um Fehler abzufangen), dass wenn alle Server nicht die gleichen Dateien haben, dass es trotzdem weiter läuft?
Beispiel:
Server1: hat Datei office–1
Server2: auch
Server3: nicht
Server4: auch nicht
und am Ende sollen alle 4 Server die Datei office–1 haben.
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hallo Gerd,
Es funktionierte auf anhieb-freu!!!
Können wir bitte noch abfangen (es geht jetzt nur noch um
Fehler abzufangen), dass wenn alle Server nicht die gleichen
Dateien haben, dass es trotzdem weiter läuft?Beispiel:
Server1: hat Datei office–1
Server2: auch
Server3: nicht
Server4: auch nichtund am Ende sollen alle 4 Server die Datei office–1 haben.
mal etwas Leichtes, noch nicht mal Fehlerträchtig!
Ist eingebaut, da gab es auch nichts falsch zu machen.
Gruß Rainer
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 Befehl0\_Click()
Dim i As Integer
OpenDB
strSQL = "SELECT [Sds-task].\* FROM [Sds-task]"
OpenRS strSQL
Transfer "c:\server1\sds-task.lst"
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
ReDim Preserve Pfd(i)
Pfd(i) = objRS("SDS-Name")
i = i + 1
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()
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)
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 Sync()
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
Server(0) = "c:\Server1\"
Server(1) = "c:\Server2\"
Server(2) = "c:\Server3\"
Server(3) = "c:\Server4\"
ff = FreeFile
For i = LBound(Pfd) To UBound(Pfd)
Daten = ""
For c = 0 To 3
Pfad = Server(c) + Pfd(i)
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)
QuickSort LBound(Feld), UBound(Feld)
Clean
Daten = Join(Feld, vbCrLf)
For c = 0 To 3
Pfad = Server(c) + Pfd(i)
Open Pfad For Output As #ff
Print #ff, Daten
Close #ff
Next
End If
Next
End Sub
Hallo Rainer,
du wirst mir langsam unheimlich…es funktioniert!!!
Eine kleine Sache hab ich leider noch…in der ganzen Aufregung habe ich übersehen, dass die Files die zurückgeschrieben werden die Endung .yes haben müssen. Sorry, weiß auch nicht wie das passieren konnte…
Beispiel:
Server1: office–1.yes
Ist das auch so aus der Hand zu schütteln oder schwieriger?
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hallo Herd,
Server1: hat Datei office–1
da fällt mir etwas auf … Office–1 ???
Ist das ein Dokument?
Nach der beschreibung, die Du bisher geliefert hast und wie das Programm arbeitet, wird dieses Dokument zerschossen, unbrauchbar.
Nur wenn die Dateien zu Deinem angegebenen Format passen, daß sie Zeilenweise gelesen werden können, ihre Inhalte aufsummiert werden und dann verändert wieder zurückgeschrieben, ergibt das Programm so einen Sinn.
Wenn sich in den Verzeichnissen Dokumente, Bilder, Datenbanken … Befinden, werden die von dem Programm zerstört!
Gruß Rainer
Hi Gerd,
du wirst mir langsam unheimlich…es funktioniert!!!
*gg* Wenn Du auch so einfache fragen stellst.
Eine kleine Sache hab ich leider noch…in der ganzen
Aufregung habe ich übersehen, dass die Files die
zurückgeschrieben werden die Endung .yes haben müssen. Sorry,
weiß auch nicht wie das passieren konnte…Beispiel:
Server1: office–1.yes
Ist das auch so aus der Hand zu schütteln oder schwieriger?
Das ist nicht schwieriger … Läuft.
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 Befehl0\_Click()
Dim i As Integer
OpenDB
strSQL = "SELECT [Sds-task].\* FROM [Sds-task]"
OpenRS strSQL
Transfer "c:\server1\sds-task.lst"
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
ReDim Preserve Pfd(i)
Pfd(i) = objRS("SDS-Name")
i = i + 1
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()
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)
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 Sync()
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\"
Server(1) = "c:\Server2\"
Server(2) = "c:\Server3\"
Server(3) = "c:\Server4\"
ff = FreeFile
For i = LBound(Pfd) To UBound(Pfd)
Daten = ""
For c = 0 To 3
Pfad = Server(c) + Pfd(i)
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)
QuickSort LBound(Feld), UBound(Feld)
Clean
Daten = Join(Feld, vbCrLf)
For c = 0 To 3
Pfad = Server(c) + Pfd(i)
Pos = InStrRev(Pfad, ".")
If Pos \> 1 Then
Pfad = Left(Pfad, Pos - 1)
End If
Pfad = Pfad + ".yes"
Open Pfad For Output As #ff
Print #ff, Daten
Close #ff
Next
End If
Next
End Sub
Hallo Rainer,
das sind die z.B. 46 Files die ausgelesen werden und der Inhalt syncronisiert wird.
Die Files die in der Query stehen,haben alle keine Endung .yes
Dank deiner Hilfe wird ja jetzt der Inhalt dieser Files syncronisiert und jeweils auf die 4 Server zurück geschrieben, nur da müssen sie die Endung .yes haben…
Gruss Gerd
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]