'Version du 24 juin 2013 'Nécessite que le client Oracle soit installé sur le poste (ici la 9.2) 'Le data source dans ConnectionString est la valeur prise sous 'Bases de données' dans le Entreprise Management Console de Oracle 'Pb avec PRU qui est un numériqu et 13, 4 pose problème, pas 13 'Voir avec un point au lieu d'une virgule ? '[PRU] [numeric](13, 4) NULL, Dim objFSO Dim objTextFileDataBrut Dim objTextFileRequeteSQLInsert Dim CheminFichierDataBrut Dim CheminFichierRequeteSQLInsert Dim CheminScriptActuel Dim LineNumber Dim RequeteNomTableSelect Dim RequeteNomBaseInsert Dim RequeteNomTableInsert Dim RequeteInsert01 Dim RequeteInsert02 Dim RequeteInsertComplete 'Déclaration des constantes Const ForReading = 1 Const ForWritting = 2 Const ForAppending = 8 'Constantes pour le recordset Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenDynamic = 2 Const adOpenStatic = 3 '---- LockTypeEnum Values ---- Const adLockReadOnly = 1 Const adLockPessimistic = 2 Const adLockOptimistic = 3 Const adLockBatchOptimistic = 4 '---- CursorLocationEnum Values ---- Const adUseServer = 2 Const adUseClient = 3 Const adCmdText = 1 Const adModeRead = 1 Const adModeReadWrite = 3 Call DetectExeType RequeteNomTableSelect = "ma.table" RequeteNomBaseInsert = "NomBaseOracle" RequeteNomTableInsert = "dbo.NomTableCible" CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1) CheminFichierDataBrut = CheminScriptActuel & "\VbOracleExport_Export.txt" 'Déclaration du chemin et du nom du fichier CheminFichierRequeteSQLInsert = CheminScriptActuel & "\VbOracleExport_RequeteSQLInsert.txt" If Len(CheminFichierDataBrut) > 0 Then Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFileDataBrut = objFSO.OpenTextFile(CheminFichierDataBrut, ForWritting, True) Set objTextFileRequeteSQLInsert = objFSO.OpenTextFile(CheminFichierRequeteSQLInsert, ForWritting, True) 'objTextFileDataBrut.WriteLine(Now) 'On ecrit la date et l'heure dans le fichier Set objConnection = CreateObject("ADODB.Connection") Set MonRecordset = CreateObject("ADODB.Recordset") objConnection.Mode = adModeReadWrite objConnection.CursorLocation = adUseClient objConnection.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=NomDeclarationOracle;User ID=login;Password=motdepasse" objConnection.Open Wscript.Echo "Connexion avec la Base Ok" RequeteSql = "SELECT *" RequeteSql = RequeteSql & " " & "FROM " & RequeteNomTableSelect On Error Resume Next MonRecordset.Open RequeteSql, objConnection, adOpenKeyset, adLockOptimistic 'MsgBox Err.Description LineNumber = 0 If MonRecordset.BOF = False Then MonRecordset.MoveFirst Do While MonRecordset.EOF = False LineNumber = LineNumber + 1 If LineNumber = 1 Then 'Si c'est la première ligne, on va commencer par écrire le nom des champs MaLigne = "" RequeteInsert01 = "" For CompteurChamps = 0 To MonRecordset.fields.Count - 1 MaLigne = MaLigne & MonRecordset.fields(CompteurChamps).Name & VbTab RequeteInsert01 = RequeteInsert01 & MonRecordset.fields(CompteurChamps).Name & ", " Next 'On retire le dernier caractère (la dernière tabulation etc...) If Len(MaLigne) > 0 Then MaLigne = Left(MaLigne,Len(MaLigne)-1) RequeteInsert01 = Left(RequeteInsert01,Len(RequeteInsert01)-2) End If objTextFileDataBrut.WriteLine(MaLigne) objTextFileRequeteSQLInsert.WriteLine("Use " & RequeteNomBaseInsert & ";") objTextFileRequeteSQLInsert.WriteLine("Delete * From " & RequeteNomTableInsert & ";") objTextFileRequeteSQLInsert.WriteLine("Go") End If MaLigne = "" RequeteInsert02 = "" For CompteurChamps = 0 To MonRecordset.fields.Count - 1 MaLigne = MaLigne & MonRecordset.fields(CompteurChamps).Value & VbTab 'RequeteInsert02 = RequeteInsert02 & "'" & MonRecordset.fields(CompteurChamps).Value & "'," RequeteInsert02 = RequeteInsert02 & "'" & ModifierCaractSpeRequeteSQL(MonRecordset.fields(CompteurChamps).Value) & "'," Next 'On retire le dernier caractère (la dernière tabulation) If Len(MaLigne) > 0 Then MaLigne = Left(MaLigne,Len(MaLigne)-1) RequeteInsert02 = Left(RequeteInsert02,Len(RequeteInsert02)-1) End If RequeteInsertComplete = "Insert Into " & RequeteNomTableInsert & " (" & RequeteInsert01 & ") Values (" & RequeteInsert02 & ");" objTextFileDataBrut.WriteLine(MaLigne) objTextFileRequeteSQLInsert.WriteLine(RequeteInsertComplete) 'objTextFileDataBrut.WriteLine(Now) 'On ecrit la date et l'heure dans le fichier MonRecordset.MoveNext Loop MonRecordset.Close objConnection.Close objTextFileRequeteSQLInsert.WriteLine("Go") objTextFileRequeteSQLInsert.Close 'Fermeture du fichier objTextFileDataBrut.Close 'Fermeture du fichier Set objTextFileDataBrut = Nothing Set objFSO = Nothing End If 'CheminFichierDataBrut Wscript.Echo "Termine" Sub DetectExeType() 'Version du 10 juillet 2008 Dim ScriptHost Dim ShellObject Dim CurrentPathExt Dim EnvObject Dim RegCScript Dim RegPopupType ' This is used to set the pop-up box flags. ' I couldn't find the pre-defined names RegPopupType = 32 + 4 On Error Resume Next ScriptHost = WScript.FullName ScriptHost = Right(ScriptHost, Len(ScriptHost) - InStrRev(ScriptHost, "\")) If (UCase(ScriptHost) = "WSCRIPT.EXE") Then WScript.Echo ("This script does not work with WScript.") ' Create a pop-up box and ask if they want to register cscript as the default host. Set ShellObject = WScript.CreateObject("WScript.Shell") ' -1 is the time to wait. 0 means wait forever. RegCScript = ShellObject.PopUp("Would you like to register CScript as your default host for VBscript?", 0, "Register CScript", RegPopupType) If (Err.Number <> 0) Then ReportError () WScript.Echo "To run this script using CScript, type: ""CScript.exe " & WScript.ScriptName & """" WScript.Quit (GENERAL_FAILURE) WScript.Quit (Err.Number) End If ' Check to see if the user pressed yes or no. Yes is 6, no is 7 If (RegCScript = 6) Then ShellObject.RegWrite "HKEY_CLASSES_ROOT\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\CScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ" ShellObject.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\CScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ" ' Check if PathExt already existed CurrentPathExt = ShellObject.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT") If Err.Number = &H80070002 Then Err.Clear Set EnvObject = ShellObject.Environment("PROCESS") CurrentPathExt = EnvObject.Item("PATHEXT") End If ShellObject.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT", CurrentPathExt & ";.VBS", "REG_SZ" If (Err.Number <> 0) Then ReportError () WScript.Echo "Error Trying to write the registry settings!" WScript.Quit (Err.Number) Else WScript.Echo "Successfully registered CScript" End If Else WScript.Echo "To run this script type: ""CScript.Exe adsutil.vbs """ End If Dim ProcString Dim ArgIndex Dim ArgObj Dim Result ProcString = "Cscript //nologo " & WScript.ScriptFullName Set ArgObj = WScript.Arguments For ArgIndex = 0 To ArgCount - 1 ProcString = ProcString & " " & Args(ArgIndex) Next 'Now, run the original executable under CScript.exe Result = ShellObject.Run(ProcString, 0, True) WScript.Quit (Result) End If End Sub Public Function ModifierCaractSpeRequeteSQL(ByVal MaLigne) 'Version du 25 juillet 2008 'Ex Version du 3 janvier 2007 'Modifie les caractères spéciaux d'une requête SQL par leur code ASCII pour ne pas la faire planter les requêtes à cause de caractères réservés 'Caractères comme ' , ; 'Par defaut ModifierCaractSpeRequeteSQL = MaLigne If Len(Trim(MaLigne)) > 0 Then 'ParametresScriptForSQL = Replace(ParametresScriptForSQL,",","' + Char(44) + '") MaLigne = Replace(MaLigne, "'", "' + Char(39) + '") 'Cette ligne doit être passée en premier MaLigne = Replace(MaLigne, ";", "' + Char(59) + '") 'MaLigne = Replace(MaLigne, "+", "' + Char(43) + '") MaLigne = Replace(MaLigne, Chr(9), "' + Char(9) + '") MaLigne = Replace(MaLigne, Chr(10), "' + Char(10) + '") MaLigne = Replace(MaLigne, Chr(13), "' + Char(13) + '") ModifierCaractSpeRequeteSQL = MaLigne End If 'If Len(Trim(MaLigne)) > 0 Then End Function