'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 <cmd> <params>"""
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
Lien vers le fichier : cliquez ici
