Export Import Oracle en VbScript

'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