VBScript et erreur Access à récupérer

Bonjour,

J'écris un script pour récupérer des données de SQL Server vers Access.
Et j'ai des soucis : je voudrais savoir l'erreur provoquée par l'exécution de la requête d'insertion.

Merci d'avance pour votre aide.

Script qui récupère des données d'une base SQL Server pour écrire dans une base Access :

--- Install.wsf ---
<!-- <?XML versio="1.0" standalone="yes" ?> -->
<package>

<job id="export"><?job debug="true" ?>

<runtime>
<description>Import de données de SQL Server</description>
<example>Exemple : Install.wsf //job:import</example>
<usage></usage>
</runtime>

<script language="VBScript" src="parametrage.vbs"/>
<script language="VBScript" src="import.vbs"/>
<script language="VBScript">

WScript.Echo "Fin de l'importation."
WScript.Quit
</script>

</job>

</package>


--- parametrage.vbs ---

Const strTOOL_NAME = "RIP" ' Nom de l'outil
Const cnnStringSQLServer = "driver={SQL Server};server=GO-9J2451J;uid=RIPadmin;password=RIPadmin;database=RIP"
Const cnnStringAccess = "Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\Documents and Settings\Mon nom\Mes documents\GS\RIP\var\data\RIP_STA.mdb"


--- import.vbs ---

Dim cnnAccess
Dim cnnSQLServer

Public msgStatut

Set cnnSQLServer = CreateObject("ADODB.Connection")
cnnSQLServer.ConnectionString = cnnStringSQLServer
cnnSQLServer.Open
WScript.Echo "open"

Set cnnAccess = CreateObject("ADODB.Connection")
cnnAccess.ConnectionString = cnnStringAccess
cnnAccess.Open
WScript.Echo "open"

Public i
Public idxPremier
Public rstA
Public rstS
Public arrIdQualNet
Public arrPilotes
Public fld
Public nbFld
Public idxFld
Public strColonne
Public cmd
Public insQuery
Public datYear
Public datMonth
Public datDay
Public datHour
Public datMinute
Public datSecond

Public theError

set rstA = CreateObject("ADODB.Recordset")
set rstS = CreateObject("ADODB.Recordset")
set cmd = CreateObject("ADODB.Command")

msgStatut = ""
msgStatut = msgStatut & "Transaction sur les Evénements -> annulée"

Call evenements(msgStatut)

msgbox msgStatut

set rstA = Nothing
set rstS = Nothing

cnnAccess.Close
WScript.Echo "closed"

cnnSQLServer.Close
WScript.Echo "closed"

Set cnnSQLServer = Nothing
Set cnnAccess = Nothing


Public Sub evenements(Byref msgStatut, Byref cmd)
On Error resume Next

' Ouverture du Recordset
rstA.Open "SELECT * FROM EVENEMENTS", cnnAccess
nbFld = rstA.fields.count
strColonne = ""
for idxFld = 0 to nbFld - 1
if idxFld = 0 then
strColonne = "" & rstA.fields(idxFld).name
else
strColonne = strColonne & ", " & rstA.fields(idxFld).name
end if
next
arrIdQualNet = ""
if not rstA.eof then rstA.movefirst
idxPremier = 1
while not rstA.eof
if idxPremier = 1 then
arrIdQualNet = "'" & rstA.fields("REF_LIEN") & "'"
idxPremier = 0
else
arrIdQualNet = arrIdQualNet & ", '" & rstA.fields("REF_LIEN") & "'"
end if
rstA.movenext
wend
if arrIdQualNet <> "''" or arrIdQualNet = "" then arrIdQualNet = "(" & arrIdQualNet & ")"
WScript.Echo arrIdQualNet
if arrIdQualNet = "()" or arrIdQualNet = "''" then
rstS.Open "SELECT * FROM EVENEMENTS", cnnSQLServer
else
rstS.Open "SELECT * FROM EVENEMENTS WHERE REF_LIEN NOT IN " & arrIdQualNet, cnnSQLServer
end if

if not rstS.eof then rstS.movefirst
while not rstS.eof
insQuery = ""
insQuery = "INSERT INTO EVENEMENTS (" & strColonne & ") values ("
nbFld = rstS.fields.count

for idxFld = 0 to nbFld - 1
if idxFld = 0 then
select case rstS.fields(idxFld).type
case 200
insQuery = insQuery & "'" & sqlChaine(rstS.fields(idxFld)) & "'"
end select
else
select case rstS.fields(idxFld).type
case 200
if isNull(rstS.fields(idxFld)) = true then
insQuery = insQuery & ", Null"
else
insQuery = insQuery & ", '" & sqlChaine(rstS.fields(idxFld)) & "'"
end if
case 135
if rstS.fields(idxFld).name = "INS_DATE" or rstS.fields(idxFld).name = "DEL_DATE" then
datYear = Year(rstS.fields(idxFld))
datMonth = Month(rstS.fields(idxFld))
if datMonth < 10 then datMonth = "0" & datMonth
datDay = Day(rstS.fields(idxFld))
if datDay < 10 then datDay = "0" & datDay
datHour = Hour(rstS.fields(idxFld))
if datHour < 10 then datHour = "0" & datHour
datMinute = Minute(rstS.fields(idxFld))
if datMinute < 10 then datMinute = "0" & datMinute
datSecond = Second(rstS.fields(idxFld))
if datSecond < 10 then datSecond = "0" & datSecond

if isNull(rstS.fields(idxFld)) = true then
insQuery = insQuery & ", Null"
else
insQuery = insQuery & ", '" & datMonth & "/" & datDay & "/" & datYear & " " & datHour & ":" & datMinute & ":" & datSecond & "'"
end if
else
if isNull(rstS.fields(idxFld)) = true then
insQuery = insQuery & ", Null"
else
datYear = Year(rstS.fields(idxFld))
datMonth = Month(rstS.fields(idxFld))
if datMonth < 10 then datMonth = "0" & datMonth
datDay = Day(rstS.fields(idxFld))
if datDay < 10 then datDay = "0" & datDay
insQuery = insQuery & ", '" & datMonth & "/" & datDay & "/" & datYear & "'"
end if
end if

case 11
if isNull(rstS.fields(idxFld)) = true then
insQuery = insQuery & ", Null"
else
if rstS.fields(idxFld) = "Vrai" then
insQuery = insQuery & ", 1"
else
insQuery = insQuery & ", 0"
end if
end if

case 3
if isNull(rstS.fields(idxFld)) = true then
insQuery = insQuery & ", Null"
else
insQuery = insQuery & ", " & rstS.fields(idxFld)
end if

end select
end if
next

insQuery = insQuery & ")"
WScript.Echo insQuery

cmd.ActiveConnection = cnnAccess
cmd.CommandText = "DBEngine.BeginTrans"
cmd.Execute

cmd.ActiveConnection = cnnAccess
cmd.CommandText = insQuery
' ou
'cmd.CommandText = "CurrentDb.Execute " & insQuery & ", dbFailOnError"
cmd.Execute

set theError = cmd.Error

if theError.Number <> 0 then
cmd.ActiveConnection = cnnAccess
cmd.CommandText = "DBEngine.Rollback"
cmd.Execute

msgStatut = "" & "Transaction sur les Evénements --> annulée"
msgbox "Error " & theError.Number & vbLf & theError.Description
exit sub

else
cmd.ActiveConnection = cnnAccess
cmd.CommandText = "DBEngine.CommitTrans"
cmd.Execute

msgStatut = "" & "Transaction sur les Evénements --> OK"

end if

set theError = Nothing

rstS.movenext
wend

' Fermeture du Recordset
rstA.Close
rstS.Close

End Sub


Function sqlChaine(strChaine)

Dim strStart
Dim strEnd

'
sqlChaine = ""

' Doubler les apostrophes (simples quotes)
strStart = 0
Do
strEnd = InStr(strStart + 1, strChaine, "'", vbTextCompare)
If IsNull(strEnd) Then Exit Do
If strEnd = 0 Then
sqlChaine = sqlChaine & Right(strChaine, Len(strChaine) - strStart)
Exit Do
End If
sqlChaine = sqlChaine & Mid(strChaine, strStart + 1, strEnd - strStart) & "'"
strStart = strEnd
Loop

' Remplacer les vbNewline par \n
'sqlChaine = strSubst(sqlChaine, vbNewLine, "\n")

End Function