VBScript et erreur Access à récupérer

VBScript et erreur Access à récupérer - VB/VBA/VBS - Programmation

Marsh Posté le 24-10-2005 à 11:58:53    

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.  
 
 
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


---------------
Michèle
Reply

Marsh Posté le 24-10-2005 à 11:58:53   

Reply

Marsh Posté le 25-10-2005 à 18:35:11    

A quel moment tu as une erreur ?
 
Parce qu'il me semble que si tu fais un INSERT dans une table ou tu as 4 champs, il te faut obligatoirement 4 Valeurs, Sinon c'est un UPDATE qu'il faut faire ( Mais si l'enregistrement existe ! )
 
S'il n'existe pas :
 
INSERT INTO EVENEMENTS ( Colone1, colone2,...) VALUES ( Valeur1, NULL, NULL, NULL )
 
NULL Si tu est dans le cas 200 et  If idxFld = 0 Then, car là tu as un INSERT qui n'est pas bon du fait de ne rentrer qu'une valeur sur un champs au lieu des 4 que contient la table !
 
Essai déjà de voir ça et tiens moi au courant...
 
@+ Fred

Reply

Marsh Posté le 26-10-2005 à 12:37:25    

Merci pour la remarque :  
Heu pour l'instruction d'insert, ça marche finalement : en fait je n'ai pas le même ordre dans les noms de champs dans les bases Access et MSDE.
Aussi j'ai fait :

nbFld = rstS.fields.count
    strColonne = ""
    for idxFld = 0 to nbFld - 1
 if idxFld = 0 then
    strColonne = "" & rstS.fields(idxFld).name
 else    
    strColonne = strColonne & ", " & rstS.fields(idxFld).name
 end if    
    next

a la place de rstA.
 
Sinon j'ai autre chose à te demander si tu sais : je voudrais savoir si l'opération d'insertion s'est bien déroulée, avoir un compte-rendu en quelque sorte. C'est ce à quoi sert mon msgStatut. Mais apparemment je n'arrive pas à me dépatouiller, à savoir quand l'opération s'est bien déroulée ou non :

cmd.ActiveConnection = cnnAccess
   ' Début de ma transaction
   cmd.CommandText = "DBEngine.BeginTrans"
   cmd.Execute
   
   cmd.ActiveConnection = cnnAccess
   ' Exécution de la requête "Insert into ..."
   cmd.CommandText = insQuery
   cmd.Execute
   
   ' J'ai essayé ça  
   set theError = cmd.Error
   
   ' Je n'arrive pas à trouver la bonne condition pour mon If, apparemment cela doit être le contraire mais l'opération d'insert s'est passée et il m'affiche "2 - " & "Transaction sur les Evénements --> annulée"        
   if not isnull(theError.description) then
   'if theError.Number <> 0 then
       cmd.ActiveConnection = cnnAccess
       cmd.CommandText = "DBEngine.Rollback"
       cmd.Execute  
       msgStatut = "2 - " & "Transaction sur les Evénements --> annulée"  
       ' il ne m'affiche pas ce message :    
       msgbox "Error " & 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

Merci pour ton aide.


---------------
Michèle
Reply

Marsh Posté le 26-10-2005 à 22:53:09    

Pour l'objet Cmd il n'y à pas de propriété Error...
 
Tu peux essayer ça : Sait on jamais...
 
Dim errorObject  
Dim Cnx
Dim Cmd
Dim StrError
 
     
Set Cnx = WScript.CreateObject("ADODB.Connection" )*
Set Cmd = WScript.CreateObject("ADODB.Command" )
Set errorObject  = WScript.CreateObject("ADODB.Error" )
   
 
' La première des choses est de voir ce que tu récupères ici dans TheError
Set TheError = Cmd.Execute
     
' La deuxième est de mettre ça
' Ca peut permettre de voir ce qu'il se passe
 
On Error GoTo ErrorHandler
     
     
ErrorHandler:
 
    ' Enumerate Errors collection and display
    ' properties of each Error object
    For Each errorObject In Cnx.Errors
        StrError = "Error #" & errorObject.Number & vbCr & _
            "   " & errorObject.Description & vbCr & _
            "   (Source: " & errorObject.Source & " )" & vbCr & _
            "   (SQL State: " & errorObject.SQLState & " )" & vbCr & _
            "   (NativeError: " & errorObject.NativeError & " )" & vbCr
        If errorObject.HelpFile = "" Then
            StrError = StrError & "   No Help file available"
        Else
            StrError = StrError & _
               "   (HelpFile: " & errorObject.HelpFile & " )" & vbCr & _
               "   (HelpContext: " & errorObject.HelpContext & " )" & _
               vbCr & vbCr
        End If
         
        MsgBox strError
    Next
 
Tiens moi au courant...
 
@+ Fred

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed