Okay, zu mit schreiben.
Ich habe ein Datenbank und einen Exchange Server. In der Datenbank liegen die ganzen Ansprechpartner mit Firma usw.
Die Ansprechpartner sollen auf den Exchange Server und sie tauchen nach her in Outlook bei Alle öffentliche Ordner auftaucht.
Stellt euch vor ihr habt Outlook und geht auf der öffentlich Ordner da stehen alle Ansprechpartner die ihr gerne schreiben möchtet und das sind so ungefähr 7000 an der Zahl aber es kann sich ja was ändern z.B. ein Ansprechpartner stirbt oder er arbeitet nicht mehr in der Firma.
Und da für schreibe ich ein Script, was in bestimmten Abständen gestartet wir und je nach dem ob das Script schon mal im gleich Monat gelaufen ist wird ein Update gefahren und wurde das Script noch nicht in diesem Monat gestartet. Soll einen Volllöschung auf den Exchange Server vorgenommen werden und gleich im anschluss sollen alle Daten neu auf den Exchange Server auf gespielt werden.
Und mein Problem ist das die Volle Löschung auf den Exchange Server zu langsam geht!
Wenn ihr mich immer noch nicht versteht, schaut euch das an!!!!
strSqlSource = "SELECT * FROM VIEW_EXCHANGE WHERE (FADeaktiv = 'FF')"
'strSQLAditoDeaktiv= "SELECT AID FROM VIEW_EXCHANGE WHERE (FADeaktiv = 'WW' OR FADeaktiv = 'FW' OR FADeaktiv = 'WF' OR FDatumEdit > '"&s(0)&"' OR ADatumEdit > '"&s(0)&"' OR MDatumEdit > '"&s(0)&"' OR FDatumNeu > '"&s(0)&"' OR ADatumNeu > '"&s(0)&"')"
strMSSQL = "Provider='sqloledb';Data Source='SVR-12';Initial Catalog= 'Inros_Daten';Integrated Security=SSPI"
strURL_Full = "http://SVR-04/public/Adito-Adressen/"
strSQLLoeschen = "SELECT * FROM VIEW_EXCHANGE "'WHERE (FADeaktiv = 'WW' OR FADeaktiv = 'FW' OR FADeaktiv = 'WF' OR FADeaktiv = 'FF') "
'Call MsgBox(strSQLLoeschen)
'---dynamische Einstellungen
'Von C# in VB anfang 13.12.04 erstellen
Dim Zaehler 'As Integer = 1
Dim Test 'As Integer
Zaehler = 1
'Schaut ob die Datei vorhanden ist wenn Ja öffnet sie die Datei und liest den in halt ein
'wenn nicht erstellt sie die Datei mit einen Start wert und das Aktuelle Datum
If fso.FileExists("Zwischen.txt") Then
Set FileIn = fso.OpenTextFile("Zwischen.txt")
Dim wert
wert = FileIn.ReadAll()
FileIn.Close()
Dim s
s = Split(wert, ";")
Test = s(0)' Convert.ToInt32(s(0))
Loeschen = Test
'Überprüft ob Array 0 größer drei ist wenn ja wird der Zähler auf Standart zuzückgestellt
'wenn nicht denn wird das Array hoch gezählt und in der Datei abgespeichert.
Dim Monat
Monat = Month(Date())
'Call MsgBox(Monat)
'Call MsgBox(s(0))
If Monat <> Month(Test) Then 'If Test > 3 Then
Set FileOut = fso.CreateTextFile("Zwischen.txt")
FileOut.Write Date()&" 23:00:00" '&";"& Month(Date())'Zaehler &";"& Date()& ";" & Month(Date())
FileOut.Close
Else
Set FileOut = fso.CreateTextFile("Zwischen.txt")
FileOut.Write Date()&" 23:00:00" '&";"& Month(Date())
FileOut.Close
strSqlSource = strSqlSource & " AND FDatumEdit > '"&s(0)&"' OR ADatumEdit > '"&s(0)&"' OR MDatumEdit > '"&s(0)&"' OR FDatumNeu > '"&s(0)&"' OR ADatumNeu > '"&s(0)&"'"
'Call MsgBox(strSqlSource)
End If
Else
'erstellen einer zwischenspeicherdatei
Set FileOut = fso.CreateTextFile("Zwischen.txt")
FileOut.Write Date()&" 23:00:00" '&";"& Month(Date())
FileOut.Close
End If
strSQLAditoDeaktiv= "SELECT AID FROM VIEW_EXCHANGE WHERE (FADeaktiv = 'WW' OR FADeaktiv = 'FW' OR FADeaktiv = 'WF' OR FDatumEdit > '"&s(0)&"' OR ADatumEdit > '"&s(0)&"' OR MDatumEdit > '"&s(0)&"' OR FDatumNeu > '"&s(0)&"' OR ADatumNeu > '"&s(0)&"')"
WScript.Echo "Start des VBScripts "&WScript.ScriptName&"!"
If Err.Number <> 0 Then
Err.Clear
End If
Set objCnnSource = CreateObject("ADODB.Connection") ' create connection to connect to ODBC datasource
Set objRstSource = CreateObject("ADODB.Recordset") ' create recordset to get data from ODBC datasource
Set objRstAditoDeaktiv = CreateObject("ADODB.Recordset") ' create recordset to get data from ODBC datasource
' Set objRstGanzLoeschen = CreateObject("ADODB.Recordset")
objCnnSource.ConnectionString = strMSSQL 'User ID='AditoToExchange';Password='ATE';"
objCnnSource.CursorLocation = adUseClient
objCnnSource.Open ' open a connection
' Error handler
If Err.Number <> 0 Then
If objCnnSource.State = adStateOpen Then
objCnnSource.Close
End If
Set objCnnSource = Nothing
WScript.Echo "Cannot connect to the datasource"
Exit Sub
End If
' Clear Err object to trap only errors in connecting to recordset
If Err.Number <> 0 Then
Err.Clear
End If
objRstSource.CursorLocation = adUseClient
objRstSource.Open strSqlSource, objCnnSource, adOpenStatic, adLockReadOnly, adCmdText
objRstAditoDeaktiv.Open strSQLAditoDeaktiv, objCnnSource, adOpenStatic, adLockReadOnly, adCmdText
'objRstGanzLoeschen.Open strSQLLoeschen, objCnnSource, adOpenStatic, adLockReadOnly, adCmdText
If Err.Number <> 0 Then
If objRstSource.State = adStateOpen Then
objRstSource.Close
End If
If objCnnSource.State = adStateOpen Then
objCnnSource.Close
End If
If objRstAitoDeaktiv.State = adStateOpen Then
objRstAditoDeaktiv.Close
End If
'If objRstGanzLoeschen.State = adStateOpen Then
'objRstGanzLoeschen.Close
' End If
Set objRstSource = Nothing
Set objCnnSource = Nothing
Set objRstAditoDeaktiv = Nothing
'Set objRstGanzLoeschen = Nothing
WScript.Echo "Cannot connect to the datasource"
Exit Sub
End If
'If Monat <> Month(Loeschen) Then
'variable ja oder nein
'Loesche_ganz = True
'Do While Not objRstGanzLoeschen.EOF
'ZZZ=ZZZ+1
'If WHEREAID1 <> "" Then
'WHEREAID1 = WHEREAID1 & " OR "
'End If
'WHEREAID1 = WHEREAID1 + """urn:schemas:contacts:customerid"" = '"& objRstGanzLoeschen.Fields("AID").Value &"'"
'IDsDeaktiv=IDsDeaktiv&", "&objRstAditoDeaktiv.Fields("AID").Value
'objRstGanzLoeschen.MoveNext
'Loop
'objRstGanzLoeschen.Close
'Else
'variable ja oder nein
Loesche_ganz = False
Do While Not objRstAditoDeaktiv.EOF
'ZZZ=ZZZ+1
If WHEREAID <> "" Then
WHEREAID = WHEREAID & " OR "
End If
WHEREAID = WHEREAID + " ""urn:schemas:contacts:customerid"" = '"& objRstAditoDeaktiv.Fields("AID").Value &"'"
IDsDeaktiv=IDsDeaktiv&", "&objRstAditoDeaktiv.Fields("AID").Value
objRstAditoDeaktiv.MoveNext
Loop
objRstAditoDeaktiv.Close
'---Finished getting cutomer information,
'---Now checking and creating contacts in exchange target
' Clear Err object to trap only errors in connecting to public folder
If Err.Number <> 0 Then
Err.Clear
End If
' set properties for the connection to the public folder
' Please consider to change the strURL when change the public folder
Set objCnnTargetFull = CreateObject("ADODB.Connection")
objCnnTargetFull.Provider = "ExOLEDB.DataSource"
objCnnTargetFull.Mode = adModeReadWrite
objCnnTargetFull.Open strURL_Full 'open a connection to the public folder to create data
' Error handler
If Err.Number <> 0 Then
If objRstSource.State = adStateOpen Then
objRstSource.Close
End If
If objCnnSource.State = adStateOpen Then
objCnnSource.Close
End If
Set objRstSource = Nothing
Set objCnnSource = Nothing
Set objCnnTargetFull = Nothing
WScript.Echo "Cannot connect to public folder"
Exit Sub
End If
'Von Dirk eingefügte Löschprozedur ...
Set oRec = CreateObject("ADODB.Record")
Set oRst = CreateObject("ADODB.Recordset")
oRec.Mode = adModeReadWrite
oRec.Open strURL_Full 'geändert 15.12.04
'erstellt 15.12.04
If Monat <> Month(Loeschen) Then
'Volllöschung 20.12.2004
sSQL="select * from """&strURL_Full&""""
sSQL=sSQL & " WHERE "
sSQL=sSQL & "(""http://schemas.microsoft.com/exchange/outlookmessageclass"" != 'IPM.Microsoft.FolderDesign.FormsDescription')"
'sSQL=sSQL & " AND ( "
'sSQL=sSQL & WHEREAID1
'sSQL=sSQL & " ) "
WScript.StdOut.WriteLine("Abfrage für die Volllöschung!")
Else
'Teillöschung 20.12.2004
sSQL="select * from """&strURL_Full&""""
sSQL=sSQL & " WHERE "
sSQL=sSQL & "(""http://schemas.microsoft.com/exchange/outlookmessageclass"" != 'IPM.Microsoft.FolderDesign.FormsDescription')"
sSQL=sSQL & " AND ( "
sSQL=sSQL & WHEREAID
sSQL=sSQL & " ) "
WScript.StdOut.WriteLine("Abfrage für die Teillöschung!")
End If
oRst.Open sSQL, oRec.ActiveConnection
Merke =0
Do While Not oRst.EOF
Merke=Merke+1
Zusatz=Zusatz+1
If Zusatz > 99 Then
'TODO 16.12.04
WScript.StdOut.Write(".") 'bei jeden 100 Datensatz
umbruch=umbruch+1
If umbruch > 49 Then
WScript.StdOut.WriteLine()
umbruch=0
End If
Zusatz=0
End If
oRst.Delete
oRst.MoveNext
Loop
If Merke < 99 Then
WScript.StdOut.WriteLine(".")
End If
WScript.StdOut.WriteLine(Merke&" Datensätze wurden gelöscht!")
oRst.close
Hoffenlich habe ich mich jetzt besser ausgedrückt!!!!
Gruß
Corinna
Ps. das ist nur die Löschung