CONNEXION AVEC VB6 ET ORACLE 9I ET EXÉCUTION D'UN FICHIER BATCH

cs_ghuysmans99 Messages postés 3982 Date d'inscription jeudi 14 juillet 2005 Statut Membre Dernière intervention 30 juin 2013 - 12 août 2011 à 22:18
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013 - 23 août 2011 à 13:37
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/53460-connexion-avec-vb6-et-oracle-9i-et-execution-d-un-fichier-batch

cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013
23 août 2011 à 13:37
Très bien.
Je te joins ci-dessous une base de Dev concernant le chargement de fichiers pour Oracle. Tu devras adapter le code mais il est simple(presque). Pour Sql Serveur c'est plus hard, car il faut tenir compte de la version du serveur et même de la realease (2008 et 2008R2 par exemple).
'-------------------------------------------------------------------------------
'Creation du fichier de format (.ctl) de chargement d'une table pour Oracle
'Creation du fichier de format (.fmt) de chargement d'une table pour SqlServeur
'-------------------------------------------------------------------------------

Public Function CreaFicFormat(ByVal TypeBase As TypeBaseDonnees, ByVal sNomTableCible As String, ByVal sRepertoire As String) As String
Dim FicCtlOra As String
Dim sScript As String
Dim i As Integer
Dim RstTmp As ADODB.Recordset
Dim iCan As Integer

'
On Error Resume Next
'
Set RstTmp = New ADODB.Recordset
RstTmp.CacheSize = 1
RstTmp.CursorLocation = adUseServer
RstTmp.LockType = adLockPessimistic
RstTmp.MaxRecords = 1
RstTmp.Open "Select * from " & sNomTableCible, dbConn, adOpenStatic, adLockOptimistic, adAsyncFetch
Do While RstTmp.State > 1
DoEvents
Loop
If dbConn.Errors.Count > 0 Then
CreaFicFormat = ""
Set RstTmp = Nothing
Exit Function
End If
'
'ORACLE creation du fichier de format (.ctl) de chargement d'une table depuis un fichier texte
If TypeBase = Base_Oracle Then
'Creation de l'entête du fichier
sScript = "Load Data" & vbCrLf & _
"INTO TABLE " & sNomTableCible & " Append " & vbCrLf & _
"FIELDS TERMINATED BY ';' TRAILING NULLCOLS " & vbCrLf & _
"(" & vbCrLf

For i = 0 To RstTmp.Fields.Count - 1
sScript = sScript & Trim(UCase(RstTmp.Fields(i).Name)) & " "
'traitement des dates If RstTmp.Fields(i).Type adDate Or RstTmp.Fields(i).Type adDBDate Or RstTmp.Fields(i).Type = adDBTime Or RstTmp.Fields(i).Type = adDBTimeStamp Then
sScript = sScript & " " & """" & "to_date(:" & RstTmp.Fields(i).Name & ",'DD/MM/YYYY HH24:MI:SS')" & """"
'Traitement des valeurs numériques ElseIf RstTmp.Fields(i).Type adBigInt Or RstTmp.Fields(i).Type adCurrency Or RstTmp.Fields(i).Type = adDecimal Or RstTmp.Fields(i).Type = adDouble Or RstTmp.Fields(i).Type = adInteger Or RstTmp.Fields(i).Type = adNumeric Or RstTmp.Fields(i).Type = adSingle Or RstTmp.Fields(i).Type = adSmallInt Then
If Not IsNull(RstTmp.Fields(i).NumericScale) Then
If Val(RstTmp.Fields(i).NumericScale) > 0 Then
sScript = sScript & " " & """" & "to_number(:" & RstTmp.Fields(i).Name & ",'" & String((Val(RstTmp.Fields(i).Precision) - Val(RstTmp.Fields(i).NumericScale)), "9") & "D" & String(Val(RstTmp.Fields(i).NumericScale), "9") & "','NLS_NUMERIC_CHARACTERS=''.,''')" & """"
Else
sScript = sScript & " " & """" & "to_number(:" & RstTmp.Fields(i).Name & ")" & """"
End If
End If
'Traitement Des Chaines
Else
If Not IsNull(RstTmp.Fields(i).DefinedSize) Then
If Val(RstTmp.Fields(i).DefinedSize) > 254 Then
sScript = sScript & " " & " CHAR(4000)"
Else
sScript = sScript & " " & """" & "to_char(:" & RstTmp.Fields(i).Name & ")" & """"
End If
End If
End If
If i < (RstTmp.Fields.Count - 1) Then sScript = sScript & "," & vbCrLf
Next i
sScript = sScript & vbCrLf & ")"
If Right(sRepertoire, 1) <> "" Then sRepertoire = sRepertoire & ""
FicCtlOra = sRepertoire & sNomTableCible & ".ctl"
Err.Clear
iCan = FreeFile(1)
Open FicCtlOra For Output As #iCan
If Err.Number = 0 Then
Print #iCan, sScript
Close #iCan
CreaFicFormat = FicCtlOra
Else
CreaFicFormat = ""
End If
End If
Set RstTmp = Nothing
End Function

'-----------------------------------------------------------------------------
'-- Intégration d'enregistrements dans une table depuis un fichier texte
'-----------------------------------------------------------------------------
Public Function LoaderTable(ByVal TypeBase As TypeBaseDonnees, ByVal sNomTableCible As String, ByVal sFichier As String, ByVal sRepertoire As String, ByVal sFicFormat As String, ByVal bDelete As Boolean, Optional ByRef sMessage_Erreur As String) As Boolean
Dim sCmd As String
Dim Retval As Variant
Dim lNbLignes As Long
Dim sMsgErr As String
'
On Error Resume Next
sMessage_Erreur = ""
'
sRepertoire = Trim(sRepertoire)
If Right(sRepertoire, 1) <> "" Then sRepertoire = sRepertoire & ""
lNbLignes = NbLignesFic(sRepertoire & sFichier, ";", , sMsgErr)
If lNbLignes <= 0 And sMsgErr <> "" Then
sMessage_Erreur = sMsgErr
LoaderTable = False
Exit Function
End If
If bDelete Then
ExecuteCommande "Truncate table " & sNomTableCible, , , sMsgErr
If sMessage_Erreur <> "" Then sMessage_Erreur = sMessage_Erreur & vbCrLf
If sMsgErr <> "" Then sMessage_Erreur = sMessage_Erreur & sMsgErr
End If
If TypeBase = Base_Oracle Then
'Création d'un script d'exécution de l'utilitaire loader.exe Oracle
'control > indique au loader le fichier de format à utiliser
'data > indique au loader le fichier source (texte) à charger
'log > indique au loader le fichier log à générer
'discard > indique au loader le fichier des lignes rejetées à générer
'errors > renseigner le nombre d'erreurs autorisées avant que le chargement ne soit annulé.
'D'autres paramètres peuvent êtres passés à la commande (voir Doc Oracle)
If Dir(sRepertoire & sNomTableCible & ".log") Then Kill sRepertoire & sNomTableCible & ".log"
If Dir(sRepertoire & sNomTableCible & ".bad") Then Kill sRepertoire & sNomTableCible & ".bad"
If Dir(sRepertoire & sNomTableCible & ".lngRejet") <> "" Then Kill sRepertoire & sNomTableCible & ".lngRejet"
sCmd = "sqlldr userid=" & dbOraUserId & " " & _
"control='" & sFicFormat & "' " & _
"data='" & sRepertoire & sFichier & "' " & _
"log='" & sRepertoire & sNomTableCible & ".log" & "' " & _
"bad='" & sRepertoire & sNomTableCible & ".bad" & "' " & _
"discard='" & sRepertoire & sNomTableCible & ".lngRejet" & "' " & _
"errors=" & lNbLignes & " Rows=10000 bindsize=20000000"
Retval = Shell(sCmd, 1) If Retval > 0 Then LoaderTable True Else LoaderTable False
End If
End Function

'--------------------------------------------------------------------------------------------------------------
'-- Rechercher le nombre de ligne d'un fichier et en option, la cohérence du nombre de séparateurs de champs
'--------------------------------------------------------------------------------------------------------------
Public Function NbLignesFic(ByVal sNomFic, Optional ByVal sSeparateur As String, Optional ByRef iNbSeparateurs As Integer, Optional ByRef sMessageErreur As String) As Long
Dim iCan As Integer
Dim lNbLig As Long
Dim sLigne As String
Dim iNbSep As Integer
Dim iNbSepMin As Integer
Dim iNbSepMax As Integer
'
On Error Resume Next
'
sNomFic = Trim(sNomFic)
sMessageErreur = ""
NbLignesFic = 0
lNbLig = 0
'
'Ouverture du fichier texte
Err.Clear
iCan = FreeFile(1)
Open sNomFic For Input As #iCan
If Err.Number <> 0 Then
'Renseigner le message d'erreur et fixer le nombre de lignes à -1 pour indiquer l'échec d'ouverture
sMessageErreur = Err.Number & "/" & Err.Description
lNbLig = -1
Else
If LOF(iCan) > 0 Then
Do While Not EOF(iCan)
Line Input #iCan, sLigne
lNbLig = lNbLig + 1
'Rechercher le nombre de séparateur de champs (si renseigné) pour les 10 premières lignes (Le nombre peut être modifié en fonction des besoins)
' Cet opération ralenti le comptage des lignes c'est pourquoi le controle des champs est limité aux premières lignes
If lNbLig < 10 And sSeparateur <> "" Then
iNbSep = NbOccurence(sLigne, sSeparateur)
If lNbLig = 1 Then
iNbSepMin = iNbSep
Else
If iNbSep < iNbSepMin Then iNbSepMin = iNbSep
End If
If iNbSepMax < iNbSep Then iNbSepMax = iNbSep
End If
Loop
If sSeparateur <> "" Then
'Indiquer si le nombre de séparateurs de champs est cohérent (égal pour chaque ligne)
If iNbSepMin <> iNbSepMax Then
sMessageErreur = "Incohérence du nombre de colonnes dans les lignes du fichier."
End If
End If
Else
'Indiquer que le fichier est vide (0 octets)
lNbLig = 0
sMessageErreur = "Fichier valide mais Vide."
End If
Close #iCan
End If
NbLignesFic = lNbLig
End Function

'---------------------------------------------------------------------------------------------
'Rechercher le nombre d'occurrence d'un caractère ou d'un goupe de caractères dans une chaine.
'----------------------------------------------------------------------------------------------
Public Function NbOccurence(sChaine As String, sSouS_Chaine As String) As Long
On Error Resume Next
NbOccurence = (Len(sChaine) - Len(Replace(sChaine, sSouS_Chaine, "", , , vbTextCompare))) / Len(sSouS_Chaine)
End Function
swappp Messages postés 11 Date d'inscription lundi 22 août 2011 Statut Membre Dernière intervention 4 septembre 2011
23 août 2011 à 13:18
Merci pour le coup de pouce, j'ai trouvé mon bonheur, un peu compliqué mais adaptable.
Merci encore.
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013
22 août 2011 à 23:04
C'est carrément un cours particulier qu'il te faut, j'imagine que c'est pour ton boulot, dans ce cas il va falloir me donner une partie de ton salaire.
Je plaisante ...
Il faudrait que tu cherches un peu, il y a plein de sources sur ce sujet, pas simple j'en conviens. Pour oracle c'est un fichier control qu'il faut créer. Regarde ces liens et inspire-toi du code:
http://www.vbfrance.com/codes/CREATION-LOADER-ORACLE_6245.aspx
http://www.vbfrance.com/codes/EASY-LOADER-ORACLE_40967.aspx
http://www.vbfrance.com/codes/ORACLE-AUTOMATISATION-CREATION-FICHIER-CONTROLE_8456.aspx
swappp Messages postés 11 Date d'inscription lundi 22 août 2011 Statut Membre Dernière intervention 4 septembre 2011
22 août 2011 à 22:47
Merveilleux, tout fonctionne sans plantage, merci encore.
Il me reste un problème, je ne parviens pas a créer un fichier format correct, aurais-tu une piste (là j'abuse un peu).
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013
22 août 2011 à 18:11
Il faut prendre du Totus les gars si vous avez un problème avec la mémoire, apparemment c'est un sujet qui vous omnibule.
Bon trèfle de plaisanterie, deux solutions.
soit tu renvoi un tableau de String et tu gères les types de données dans ta fonction comme dans l'exemple mais tu vas brider cette fonction à des chaînes de caractères elle sera moins générique. De toute façon, il est quand même rare que le nombre de champs renvoyés dépasse la cinquantaine non? , ce n'est pas inssupportable pour la mémoire!!
Soit tu renvoi un tableau en Variant qui sera brut de décoffrage, à condition bien sûr que le tableau récepteur de ta procédure appelante soit un Variant, et là tu traite les valeurs dans cette procédure. Attention si tu affectes une valeur nulle à une chaîne VB couinne et te dis que le type est incompatible. C'est vrai qu'il est important de savoir si des valeurs sont nulles, c'est pourquoi le type Variant est utilisé puis convertis en fontion des besoins.

sCommandeSav est static et mémorise la requête initiale passée en paramètre, chaque fois que la procédure appelante demande une ligne, la fonction sait si c'est bien pour la même requête sinon elle ferme le recordset et le réouvre avec la nouvelle requête. C'est une solution que j'ai trouvé mais ce n'est certainement pas la seule, il y a sûrement mieux et plus élégant, mais ça marche.
Dis-toi que la procédure appelante va appeler(évidemment) la fonction dans une boucle, il faut bien que les deux communiquent, la procédure pour demander d'ouvrir un recordset ou un nouveau recordset ainsi que le transfert des lignes une a une, et la fonction pour indiquer sa position dans le recorset et pour renvoyer les lignes. De plus la fonction contrôle si le dernier enregistrement est atteint et doit automatiquement fermer le recordset.

Attention, Null et vide sont identiques pour Oracle mais sqlserver fait la différence, pense-y lors des traitements de chaînes, si tu injecte une chaîne vide dans une base oracle, ce sera considéré comme un null et le résultat escompté n'est pas pas toujours atteint.

Bon Casse-Tête..
swappp Messages postés 11 Date d'inscription lundi 22 août 2011 Statut Membre Dernière intervention 4 septembre 2011
22 août 2011 à 17:33
Merci pour ton aide et ces précisions.
Par contre je ne comprend pas trop l'utilité de la variable sCommandeSav et ce qui déclenche la fermeture du Rs ?
Aussi, pourquoi la fonction renvoi une ligne sous forme d'un tableau de Variant, un tableau de String serait moins consommateur en mémoire non ?
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013
22 août 2011 à 17:23
Ok l'ami on occupe effectivement de la mémoire, c'est au programmeur a faire en sorte que cette occupation soit maîtrisée et raisonnable. Chaque fois qu'on déclare une variable, on occupe de la mémoire, une listebox ou un combobox occupent de la mémoire, ce sont en fait des tableaux. Et que dire d'un datagrid, au niveau occupation mémoire c'est pas mal non plus, essai de lui faire afficher une requête qui retourne plus d'un million de ligne et tu verras les effets. Pourtant sur des bases importantes, un million de lignes pour une requête c'est commun. Tout est dans l'équilibre entre gestion et performances.

Swappp, désolé, j'ai précisé que la déclaration du recordset devait être public, mais en fait dans mon code il est déclaré en static au niveau de la fonction, alors soit tu conserve soit tu supprimes la déclaration et tu la reportes en public au niveau du module, les deux fonctionnent.
Perso je préfère isoler au niveau de la fonction.

Autre chose, après l'exécution du curseur, il y a une boucle d'attente de la réponse du serveur, du type:
Do While dbRecord.State > 1
If dbConn.Errors.Count > 0 Then
If dbConn.Errors(0).Number <> 0 And dbConn.Errors(0).NativeError <> 0 Then
'Ajouter Ici le code personnalisé du traitement des erreurs
MessageErreur = dbConn.Errors(0).Number & "/" & dbConn.Errors(0).NativeError & "/" & dbConn.Errors(0).Description
'Destruction de l'objet recordset et Libération mémoire.
Set dbConn = Nothing
'Retourne un tableau vide afin de ne pas générer une erreur lors du traitement de la procédure appelante
ReDim tabRec(0)
GetDataRecord = tabRec
'Sortie prématurée de la fonction
Exit Function
End If
End If
'Rendre temporairement la main au système
DoEvents
Loop

Il vaudrait mieux la modifier comme suit:
'Boucle d'attente jusqu'à ce que le serveur renvoi soit des enregistrements soit une erreur
Do While dbRecord.State > 1
'Rendre temporairement la main au système
DoEvents
Loop
'C'est l'objet connexion qui se charge de renvoyer les erreurs éventuelles
If dbConn.Errors.Count > 0 Then
If dbConn.Errors(0).Number <> 0 And dbConn.Errors(0).NativeError <> 0 Then
'Ajouter Ici le code personnalisé du traitement des erreurs
MessageErreur = dbConn.Errors(0).Number & "/" & dbConn.Errors(0).NativeError & "/" & dbConn.Errors(0).Description
'Destruction de l'objet recordset et Libération mémoire.
Set dbConn = Nothing
'Retourne un tableau vide afin de ne pas générer une erreur lors du traitement de la procédure appelante
ReDim tabRec(0)
GetDataRecord = tabRec
'Sortie prématurée de la fonction
Exit Function
End If
End If

En effet si la réponse est immédiate, on passe trop rapidement dans la boucle et on ne gère pas les éventuelles erreurs. C'est à cause de DoEvents mais on a pas le choix, il est indispensable si on ne veut pas que l'opérateur pense à un plantage lorsque la réponse tarde.
cs_ghuysmans99 Messages postés 3982 Date d'inscription jeudi 14 juillet 2005 Statut Membre Dernière intervention 30 juin 2013 16
22 août 2011 à 16:50
(Mais ça n'enlève rien au fait que ça occupe pas mal de mémoire.)
cs_ghuysmans99 Messages postés 3982 Date d'inscription jeudi 14 juillet 2005 Statut Membre Dernière intervention 30 juin 2013 16
22 août 2011 à 16:49
@swappp,Multiprise : Désolé, celui que je visais était l'auteur. J'aurais dû préciser :s
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013
22 août 2011 à 15:47
Premièrement, la catastrophe est de ne pas réfléchir avant de faire un commentaire, désobligeant de surcroît. (ce sera tout sur le sujet).

Effectivement, si un volume important de données est à extraire, il vaut mieux être attentif à la capacité mémoire. De toute manière on ne travail pas, normalement, directement sur le serveur. Un tableau ne double pas l'occupation mémoire si la propriété cachsize est bien gérée, elle fixe le nombre d'enregistrements par 'paquet' que le serveur transmet au client jusqu'à ce que ce dernier demande le suivant. Dans mon code je donnais simplement un exemple d'utilisation.
Une solution est de modifier le code pour qu'il enregistre les lignes dans un fichier texte plutôt que dans un tableau, c'est le plus simple.
Les pièges à éviter sont :
Contrôler que dans les champs de type chaîne, le séparateur de champs que tu utiliseras ne soit pas inclu, auquel cas il faudra faire un replace(valeur_du_champ,le_separateur,le_caractere_de_remplacement).
Si tu dois réinjecter dans une base différente, oracle en l'occurrence, j'imagine que tu vas utiliser l'utilitaire Loader.exe.
Si tu ne remplaces pas les caractères tels que Chr(10), Chr(13), Chr(12).... contenus dans tes champs, le loader va planter.
De même, si ta base oracle est paramétrée avec un séparateur décimal(point ou virgule) tu dois impérativement synchroniser celui-ci dans tes champs numériques sinon seuls les entiers seront intégrés, les autres valeurs seront rejetées et la ligne ne sera pas prise en compte.
De toute manière, tu devras utiliser le loader avec un fichier format (.fmt) ne serait-ce que pour les champs au format date qui posent toujours des problèmes.
Si tu réinjecte des données oracle vers SqlServer les prérequis sont les mêmes, à part que tu vas utiliser l'utilitaire 'Bulk' de Microsoft (intégré à sqlserver). Petit piège à éviter, tu ne peux pas utiliser 'Bulk' pour charger un fichier texte depuis une machine distante, le fichier et son chemin d'accès doivent se trouver sur le serveur sans quoi tu auras en retour un beau message d'erreur. Le 'loader' d'Oracle permet, quant à lui, de charger un fichier depuis le réseau. Certains diront que le traffic réseau va être important, ce qui est vrai, mais à quoi sert un réseau si on ne s'en sert pas, à quoi sert la mémoire si on ne l'utilise pas etc..

Pour afficher le résultat d'une requête dans un contrôle , le plus simple est d'utiliser le DataGrid, et de le lier par sa propriété Datasource à ton recordset (qui doit rester ouvert évidemment).
Exemple: Set Datagrid.datasource= Mon_Recordset (et c'est tout)
Dans les propriétés du Datagrid tu actives AllowUpdate pour autoriser la modification. AllowDelete pour autoriser la suppression, AllowAdNew pour autoriser l'ajout d'un enregistrement.
Attention Oracle n'est pas en AutoCommit il faudra gérer ce point.

Voilà je pense avoir fait le tour de tes questions.

Ci_dessous la fonction modifiée qui te retournera chacun des enregistrements à traiter dans la procédure appelante.
Ce n'est qu'un support de Dev à améliorer..
La déclaration du recordset doit être Public.
'----------------------------------------------------------------------------------------------
'-- Fonction qui retourne les enregistrements un par un sous forme d'un tableau à une dimention
'-- en utilisant une connexion ouverte
'----------------------------------------------------------------------------------------------
Public Function GetDataRecord(ByVal sCommande As String, Optional ByRef PosEnregRetour As Long, Optional ByRef NbenregsTot As Long, Optional ByRef NbChamps As Integer, Optional ByVal RemplaceValeurNulle As Variant, Optional ByVal MaxEnregs As Long, Optional ByRef MessageErreur As String) As Variant()
Dim dbCols As Object
Dim i As Long
Dim DataType As ADODB.DataTypeEnum
Dim tabRec() As Variant
Dim varVal As Variant
Static PosEnreg As Long
Static dbRecord As ADODB.Recordset
Static sCommandeSav As String
'
On Error GoTo GestionErr
' If sCommandeSav "" Then sCommandeSav sCommande
If Not sCommandeSav Like sCommande Then
If Not dbRecord Is Nothing Then
If dbRecord.State = 1 Then dbRecord.Close
Set dbRecord = Nothing
End If
End If
'Vérifier si la connexion est active
If Not bLogginOk Then
MessageErreur = "Opération annulée, aucune connexion en cours."
'Retourne un tableau bi-dimentionnel vide afin de ne pas générer une erreur lors du traitement de la procédure appelante
ReDim tabRec(0)
GetDataRecord = tabRec
PosEnregRetour = -1
Exit Function
End If
MessageErreur = ""
PosEnregRetour = -1
NbenregsTot = 0
NbChamps = 0
'Création et ouverture de l'Objet recordset si 1er applel de la fonction
If dbRecord Is Nothing Then
Set dbRecord = New ADODB.Recordset
'Fixer le cache mémoire (en Nb de lignes)
dbRecord.CacheSize = 500
'Optonnel, permet de limiter le nombre d'enregistrements retournés, équivaut à <Top(10 000)> pour SqlServer , <WHERE ROWNUM <10001)> pour Oracle et <TOPMOST 10000> pour MySql
If MaxEnregs > 0 Then dbRecord.MaxRecords = MaxEnregs
'Ouverture du curseur sur la connexion active
dbRecord.Open sCommande, dbConn, adOpenStatic, adLockReadOnly, adAsyncFetch
'Boucle d'attente jusqu'à ce que le serveur renvoi soit des enregistrements soit une erreur
Do While dbRecord.State > 1
'C'est l'objet connexion qui se charge de renvoyer les erreurs éventuelles
If dbConn.Errors.Count > 0 Then
If dbConn.Errors(0).Number <> 0 And dbConn.Errors(0).NativeError <> 0 Then
'Ajouter Ici le code personnalisé du traitement des erreurs
MessageErreur = dbConn.Errors(0).Number & "/" & dbConn.Errors(0).NativeError & "/" & dbConn.Errors(0).Description
'Destruction de l'objet recordset et Libération mémoire.
Set dbConn = Nothing
'Retourne un tableau vide afin de ne pas générer une erreur lors du traitement de la procédure appelante
ReDim tabRec(0)
GetDataRecord = tabRec
'Sortie prématurée de la fonction
Exit Function
End If
End If
'Rendre temporairement la main au système
DoEvents
Loop
End If
'A ce niveau, le Curseur est valide, il reste à traiter les enregistrements retournés.
If dbRecord.RecordCount > 0 And dbRecord.State = 1 Then
'mémoriser le nombre d'enregistrements
NbenregsTot = dbRecord.RecordCount
'Mémoriser le nombre de colonnes (champs)
NbChamps = dbRecord.Fields.Count
'Redimentionner le tableau des enregistrements
ReDim tabRec(1 To NbChamps)
'Se positionner sur le premier enregistrement si PosEnreg=0
If PosEnreg <= 0 Then
dbRecord.MoveFirst
PosEnreg = dbRecord.Bookmark
PosEnregRetour = PosEnreg
ElseIf PosEnreg > 0 Then
If Not dbRecord.EOF Then
dbRecord.MoveNext
If Not dbRecord.EOF Then
PosEnreg = dbRecord.Bookmark
PosEnregRetour = PosEnreg
Else
'Fermeture du curseur
dbRecord.Close
'Destruction de l'objet Recordset
Set dbRecord = Nothing
'Retourne -1 pour indiquer que la position dans le recordset est hors limites
PosEnreg = -1
'Idem
PosEnregRetour = -1
'Renvoi un tableau vide
ReDim tabRec(0)
GetDataRecord = tabRec
Erase tabRec
'Quitter la fonction
Exit Function
End If
End If
End If
Set dbCols = dbRecord.Fields
For i = 0 To NbChamps - 1
DataType = dbCols(i).Type
varVal = dbCols(i).Value
'Traitement des valeurs nulles à modifier en fonction d'une utilisation spécifique
' remplacer la valeur nulle par la valeur de substitution si renseignée
If Not IsMissing(RemplaceValeurNulle) Then
If IsNull(varVal) Then
varVal = RemplaceValeurNulle
End If
End If
'traitement des valeurs en fonction du type et d'une utilisation ultérieure
Select Case DataType
'-- traitement des numériques
Case adInteger, adBigInt, adSmallInt, adNumeric, adSingle, adDecimal, adDouble, adCurrency
'Remplacer la virgule par un point (séparateur décimal)
If Not IsNull(varVal) Then
varVal = Replace(varVal, ",", ".")
varVal = Val(varVal)
Else
'Affectation d'une valeur d'affichage si valeur nulle
varVal = "Null"
End If
'-- Traitement des Chaînes
Case adChar, adVarChar, adVarWChar, adWChar
If Not IsNull(varVal) Then
varVal = CStr(varVal)
'Remplacer le caractère de séparateur de champs réservé, dans le texte retourné
varVal = Replace(varVal, ";", ",")
'Supprimer les caractères indésirables
varVal = Replace(varVal, vbTab, " ")
varVal = Replace(varVal, vbCr, " ")
varVal = Replace(varVal, vbLf, " ")
varVal = Replace(varVal, Chr(12), "")
If varVal <> "" And Trim(varVal) <> "" Then varVal = RTrim(varVal)
varVal = "'" & varVal & "'"
Else
'Affectation d'une valeur d'affichage si valeur nulle
varVal = "Null"
End If
'
'-- Traitement des dates
Case adDate, adDBDate, adDBTime, adDBTimeStamp
If Not IsNull(varVal) Then
If Trim(varVal) <> "" Then
varVal = "'" & Trim(CStr(varVal)) & "'"
Else
varVal = "''"
End If
Else
'Affectation d'une valeur d'affichage si valeur nulle
varVal = "Null"
End If

'Pour une fois, les difficultées ne viendront pas d'Oracle dans le traitement des dates,
' La gestion est enfantine et repose sur une fonction qui rappelle celle utilisée en VB6
'Il suffit d'appeler la fonction To_Date(Nom_De_Variable,'DD/MM/YYYY H24,NN,SS') et le tour est joué.
'Par contre, avec Sql Serveur c'est un casse-tête chinois, des fonctions dans tous les sens, des formats prédéfinis en en plus finir
' et pour couronner le tout des types incompatibles en fonction de la version du serveur (Sql2000, 2005,2008) (SmallDateTime devenu obsolète par exemple).
' mais peut-être suis-je idiot et n'ai-je rien compris à la philosophie des dates Microsoft.
'
'Pour faire simple personnellement j'utilise la fonction Cast qui a l'avantage d'exister en Oracle
'Exemple pour comparer une date en base avec une date dans une close Where:
'Dim MaDate as date
'dim MaRequete as string
'Dim MaValeur as variant
'Dim Nom_Table as string
'Dim Nom_De_Colonne as string 'MaRequete "SELECT " & MaValeur & " FROM " & Nom_Table & " Where Cast(" & Nom_De_Colonne & " AS DateTime) CAST('" & Format(MaDate,"dd/mm/yyyy hh:nn:ss.000") & "' AS DateTime & ")"
'
'-- Traitement des types spéciaux (images, texte long, binaires, blog etc...)
Case Else
'
End Select
'Alimenter le tableau des champs de l'enregistrement en cours
tabRec(i + 1) = varVal
Next i ' Champ suivant
'Transfert du tableau temporaire dans la fonction (qui retourne un tableau)
GetDataRecord = tabRec
'suppression du tableau temporaire
Erase tabRec ElseIf dbRecord.RecordCount 0 And dbRecord.State 1 Then
'Message à afficher si la requête est correcte mais qu'aucun enregistrement n'est retourné
MessageErreur = "La commande n'a pas retournée d'enregistrements correspondants aux critères de sélection."
'Retourne un tableau vide afin de ne pas générer une erreur lors du traitement de la procédure appelante
ReDim tabRec(0)
GetDataRecord = tabRec
'Retourne -1 pour indiquer que la position dans le recordset est hors limites
PosEnreg = -1
PosEnregRetour = -1
'fermeture et destruction de l'objet recordset
If Not dbRecord Is Nothing Then
If dbRecord.State = 1 Then dbRecord.Close
Set dbRecord = Nothing
End If
'Quitter la fonction
Exit Function
Else
'Retourne un tableau vide afin de ne pas générer une erreur lors du traitement de la procédure appelante
ReDim tabRec(0)
GetDataRecord = tabRec
'Retourne -1 pour indiquer que la position dans le recordset est hors limites
PosEnreg = -1
PosEnregRetour = -1
'fermeture et destruction de l'objet recordset
If Not dbRecord Is Nothing Then
If dbRecord.State = 1 Then dbRecord.Close
Set dbRecord = Nothing
End If
'Quitter la fonction
Exit Function
End If
Exit Function
GestionErr:
Debug.Print Err.Number & "/" & Err.Source & " /" & Err.Description & vbCrLf
MessageErreur = MessageErreur & Err.Number & "/" & Err.Source & " /" & Err.Description & vbCrLf
Err.Clear
Resume Next
End Function
swappp Messages postés 11 Date d'inscription lundi 22 août 2011 Statut Membre Dernière intervention 4 septembre 2011
22 août 2011 à 14:38
Multiprise..
Ton code est Super, exactement ce je je cherchais depuis longtemps, j'ai compris pourquoi des erreurs étaient renvoyées alors que le recorset était correct, comme tu l'explique, en fait, c'était des informations renvoyées par le serveur et non des erreurs. Ensuite j'ai découvert, et c'est un point très important, qu'il était possible de se connecter a Oracle sans utiliser l'Allias du TnsName.ora, donc plus besoin de rechercher et de modifier ce fichier pour accéder à la base, ça c'est génial Merci!!.
Tu retournes les enregistrements dans un tableau, effectivement c'est intéressant pour retravailler les valeurs des chaque champs, par ticulièrement si on veut faire un export en fichier texte pour un nombre limité de lignes, mais j'ai besoin d'extraire un volume très important, et là, la mémoire risque d'ètre saturée, as-tu une solution?. Egalement, pourrais-tu m'expliquer comment faire afficher dans un contôle les enregistrements de la requête(je voudrais avoir la possibilité de les modifier et les updater dans la base). Merci de tes réponses.
Ps: je suis en 10gR2 et le serveur est distant. Je dois aissi extraire des données d'un serveur Sql2008 et les réinjecter sur un serveur Oracle 10GR2.

Nb : GHUYSMANS99, je ne vois pas ou est la catatastrophe dans ce code, c'est toujours mieux que du rafistolage sur un code boîteux.
cs_ghuysmans99 Messages postés 3982 Date d'inscription jeudi 14 juillet 2005 Statut Membre Dernière intervention 30 juin 2013 16
19 août 2011 à 23:18
La vraie perspective de màj c'est ce que j'ai déjà proposé, ton code est une véritable catastrophe. Une fonction pour transformer un RS en tableau là c'est du grand n'importe quoi vu qu'on occupe plus de mémoire ... pour rien.
navyconchita Messages postés 31 Date d'inscription mercredi 10 novembre 2010 Statut Membre Dernière intervention 12 janvier 2012
19 août 2011 à 16:31
Merci multiprise, car dans la vie, il faut toujours savoir consulter les autres pour atteindre les sommets. c'est bien dit!
navyconchita Messages postés 31 Date d'inscription mercredi 10 novembre 2010 Statut Membre Dernière intervention 12 janvier 2012
19 août 2011 à 16:27
merci chogool et sutout que le code est dans une perspective de mise à jour, avec l'apport des autres chers amis à prendre en compte.
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013
19 août 2011 à 15:28
Nous avons tous un jour été novices, grâce aux autres et à la diffusion, même maladroite ou erronée, de l'expérience et de la connaissance de chacun, nous avons appri, découvert, et sommes même devenus critiques. Il n'y a pas de honte a être novice, nous sommes tous novices en fait, car nous ne connaissons pas tout (même les plus érudits).
Ne jamais avoir peur de l'inconnu, toujours penser 'Ce que les autres savent je peux l'apprendre', 'ce que les autres font je peux le faire', c'est beaucoups de travail pour certains et moins pour d'autres. Nous ne sommes pas égaux en capacités, mais quelqu'un, quelquepart a toujours besoin de tes compétences.
En informatique, le plus important c'est l'utilisateur final. Il faut, et on doit toujours penser à lui.
Un soft "bien chiadé" qui affiche un gros message d'erreur et te jette comme une "merde" est un soft de "merde" (raccourci rapide j'en conviens).
Un soft moins bien construit ou moins riche en fonctionnalités, qui t'affiche des messages d'erreur en te proposant des actions ou des explications sans te "jeter", mais en te proposant des 'portes de sortie' est un bon soft.
Lors d'un plantage de ton programme, ce n'est pas l'utilisateur qui a fait une mauvaise 'manip' qui est à blâmer, c'est toi qui est un 'tocard' de n'avoir pas pensé à l'éventualité d'un tel évênement!
Mais bref..
Ces briques de lignes sont destinées à permettre de construire un code cohérent et efficace, elles autorisent 'l'attaque' de bases d'origine différentes. Ce n'est qu'un squelette de développement adaptable et modifiable à souhait. Bien sûr il y a d'autres angles d'attataque pour arriver à un résultat équivalent.
Si des explications supplémentaires sur ce code sont nécessaires, je serai ravis('au lit') d'en apporter.

Nb : je ne 'kiff' pas paticulièrement les raviolis.
choogool Messages postés 4 Date d'inscription dimanche 6 janvier 2013 Statut Membre Dernière intervention 6 janvier 2013
19 août 2011 à 13:15
genial ce code mais pour les novice comme nous ça prendra un tout petit peu de temps avant de passer
merci.
navyconchita Messages postés 31 Date d'inscription mercredi 10 novembre 2010 Statut Membre Dernière intervention 12 janvier 2012
16 août 2011 à 09:27
Merci multiprise pour cet apport qui me sera indispensable pour la suite.
cs_Multiprise Messages postés 63 Date d'inscription jeudi 4 décembre 2003 Statut Membre Dernière intervention 23 avril 2013
16 août 2011 à 08:58
Effectivement ghuysmans99 a raison, de toute évidence, tu attaque du dev en AdoData ce qui n'est pas le plus simple. Pour t'aider un peu, je te joins un canevas de dev commenté dont tu pourras t'inspirer, je suis certain que tu comprendra mieux les subtilités du fonctionnement d'AdoData avec ces bribes de code. Bien entendu, il est nécessaire dans le projet d'ajouter la reference à 'Microsoft ActiveX Data Objects 6.0 Library'.
Si certains points te semblent obscurs n'hésite pas à poser des questions.
Bon Dev..... et bonnes nuits de Dev...

'///////////////////////////////
'
' Code a placer dans un module
'
'//////////////////////////////
'
Option Explicit ' déclaration des variables obligatoire
Option Compare Text ' comparaison en mode texte par défaut (permet d'utiliser pleinement la fonction Like)
'---------------------------------------
'
Public Enum TypeBaseDonnees
Base_Inconnu = 0
Base_Microsoft_Sql_Server = 1
Base_Oracle = 2
Base_MySql = 3
Base_Sybase = 4
End Enum
'---------------------------------------
'-- Déclaration des Variables Publiques
'---------------------------------------
Public dbServeur As String ' Nom ou adresse du serveur
Public dbUserName As String ' Nom d'utilisateur
Public dbPassword As String ' Mot de passe de l'utilisateur
Public dbDataBase As String ' Nom de la base
Public dbPort As Integer ' Port d'écoute du SqlBrother(Sql Server) ou Listener (Oracle)
Public dbType As TypeBaseDonnees ' TypeBaseDonnees
Public dbConnString As String ' Chaîne de connexion
Public dbConn As ADODB.Connection ' Objet connexion
Public bLogginOk As Boolean ' Mouchard de connexion, si établie = Vrai sinon Faux
'
'
'
'--------------------------------------------
'-- Connexion à une Base
'--------------------------------------------
Public Function ConnexionBase() As String
Dim sDescripConnOracle As String
'
On Error Resume Next
'Construction de la Chaîne de connexion en fonction du type de serveur de base
If dbType = Base_Oracle Then
'Le port d'écoute Oracle est 1521 par défaut If dbPort 0 Then dbPort 1521
'Connexion à une base de données Oracle par l'intermédiaire du TnsName
'D:\ora816\network\ADMIN\Tnsnames.ora '(exemple de localisation du fichier TnsName)
'dbConnString = "Provider=MSDAORA; Password=" & dbPassword & ";User ID=" & dbUserName & ";Data Source=" & dbDataBase 'Data Source pour Oracle est le tnsName
'Autre méthode à privilégier qui évite le paramétrage du ficher tnsnames.ora
'Connexion Directe à une base de données Oracle sans utilisation du TnsName sDescripConnOracle "(DESCRIPTION (ADDRESS=(PROTOCOL=TCP)(HOST=" & dbServeur & ")(PORT=" & dbPort & "))(CONNECT_DATA=(SERVER = DEDICATED)(SERVICE_NAME=" & dbDataBase & ")))"
dbConnString = "Provider=MSDAORA.1;Password=" & dbPassword & ";User ID=" & dbUserName & "; Data Source=" & sDescripConnOracle
ElseIf dbType = Base_MySql Then
'Le port d'écoute Mysql est 5000 par défaut If dbPort 0 Then dbPort 5000
'Connexion Directe à une base de données Mysql
dbConnString = "DRIVER={MySQL ODBC 5.1 Driver};SERVER=" & dbServeur & ";DATABASE=" & dbDataBase & ";UID=" & dbUserName & ";PWD=" & dbPassword & "; OPTION=3"
ElseIf dbType = Base_Microsoft_Sql_Server Then
'Le port d'écoute SqlServer est 1433 par défaut If dbPort 0 Then dbPort 1433
'Connection Directe à une base de données SQL Serveur.
dbConnString = "Provider=MSDASQL; driver={SQL Server};" & "server=" & dbServeur & " ;uid=" & dbUserName & ";pwd=" & dbPassword & ";database=" & dbDataBase
ElseIf dbType = Base_Sybase Then
'A developper
End If
'Vérifier si une instance de connexion existe et si oui, vérifier si la connexion est ouverte
If Not dbConn Is Nothing Then
'Si la connexion est ouverte dbConn.State=1 ele est fermée
If dbConn.State > 0 Then dbConn.Close
Set dbConn = Nothing
End If
'création de l'objet connexion
Set dbConn = New ADODB.Connection
'Pour Oracle en particulier, si la connexion n'est pas côté client, lors de l'ouverture d'un recorset,
' la fonction RecordCount renverrra toujours -1 même si le recordset contient 1 ou plusieurs enregistrements.
' de même, l'appel à la fonction BookMark (position dans le recordset) renverra une erreur (fonction non gérée par le fournisseur)
'Par contre si la connexion est destinée à recuillir des informations (type de données, null autorisé, valeur par défaut etc..)
' il est préférable d'utiliser un curseur côté serveur qui sera plus riche en informations.
dbConn.CursorLocation = adUseClient
'Temps d'attente en secondes, avant d'annuler la commande (0= Attendre indéfiniement)
dbConn.CommandTimeout = 0
'Détermine en secondes le temps maximum d'attente de réponse du serveur avant de renvoyer un message d'échec
dbConn.ConnectionTimeout = 30
'-------------------------------------------------------------------
'-- Etablissement de la connexion avec le serveur mode Asynchrone --
'-------------------------------------------------------------------
'NB:
' Le mode asynchrone est à privilégier car moins perturbant pour l'utilisateur,
' en effet, lors d'une connexion synchrone, l'interface reste bloquée jusqu'à la réponse du serveur,
' si pour une raison quelconque, la réponse tarde un peu, l'utilisateur va penser qu'il y a plantage,
' un message (ne répond pas) s'affichant dans la barre des titres de l'application qui n'est alors plus accessible.
' La seule raison pour laquelle on choisira le mode synchrone est liée aux performances, lorsque de nombreuses
' connexions et déconnexions sont nécessaires ((+ de 20 par seconde) ce qui ne devrait pas arriver si le code est optimisé).
' Ceci dit, si de nombreuses transactions sont prévues, il vaut mieux laisser la connexion ouverte, c'est la raison pour
' laquelle, j'ai volontairement déclaré l'objet connexion en variable globale.
'NB:
' Pour une connexion Oracle, et même si le nom d'utilisateur et le mot de passe sont contenus dans la chaîne de connexion,
' il est préférable de renseigner à nouveau ces derniers lors de l'ouverture de la connexion,
' Oracle étant pointilleux et pouvant parfois (même souvent) renvoyer un message d'erreur même s'il accepte la connexion.
bLogginOk = True ' Le mouchard de connexion est renseigné à priori a Vrai
dbConn.Open dbConnString, dbUserName, dbPassword, 16
'Boucle d'attente de connexion jusqu'à ce que le serveur renvoi une réponse (Positive :dbConn.State=1 Négative dbConn.State=0)
Do While dbConn.State > 1
'dbConn.Errors.Count=0 tant que le serveur ne renvoi pas de message d'erreur
'Nb: à ce stade, il n'est pas possible de tester les erreurs, le tableau des erreurs étant null
' Si un test du type If dbConn.Errors(0).Number <> 0 est effectué ici, une belle erreur programme apparaît
If dbConn.Errors.Count > 0 Then
'Ce n'est pas parceque dbConn.Errors.Count est >0 qu'il y a nécessairement une erreur de connexion,
' dans certains cas, le serveur peut simplement renvoyer une information (par exemple qu'il a modifié certains paramètres pour optimiser la connexion)
' C'est pourquoi il faut tenir compte non seulement de Errors.Count mais également du n° d'erreur globale et du N° de l'erreur d'origine.
If dbConn.Errors(0).Number <> 0 And dbConn.Errors(0).NativeError <> 0 Then
'Ajouter Ici le code personnalisé du traitement des erreurs
' Dans un module un MsgBox est à proscrire. C'est donc la fonction qui retourne sous forme de chaîne les erreurs éventuelles.
' Ici seule la première erreur est prise en considération(suffisant en gal),
' mais il faudait évidemment pour être précis, ajouter le traitement des autres si Errors.Count est > 1
ConnexionBase = dbConn.Errors(0).Number & "/" & dbConn.Errors(0).NativeError & "/" & dbConn.Errors(0).Description
'Le mouchard de connexion est renseigné à Faux
bLogginOk = False
'Initialiser la chaîne de connexion
dbConnString = ""
'Destruction de l'objet connexion et Libération mémoire.
Set dbConn = Nothing
'Sortie prématurée de la fonction
Exit Function
End If
End If
'Rendre temporairement la main au système
DoEvents
Loop
'
'A ce stade, la connexion est établie et active.
'Soit elle reste active, et la fonction se termine
'Soit elle peut être fermée par le code qui suit (en commentaires)
'dbConn.Close
'Set dbConn=Nothing
'////////////////////////////////////////////////////////////////////////////////
'Oracle nécessite un traitement supplémentaire en fonction du format des données
'Par défaut, la base Oracle est paramétrée en fontions des options régionnales.
'En france, le format des dates est JJ/MM/AAAA et le séparateur décimal est la virgule.
'En gal on utilise en informatique, le point plutot que la virgule, c'est pourquoi il va falloir indiquer
'au moteur de la base, les formats que nous voulons employer.
If dbType = Base_Oracle Then
'Fixer le format de date en JJ/MM/AAAA.
dbConn.Execute "Alter session set nls_date_format='DD/MM/YYYY'"
'Fixer le point comme séparateur décimal
dbConn.Execute "Alter session set nls_numeric_characters = '" & "." & Chr(255) & "'"
'valider la transaction (Normalement inutile pour ce type de commande)
dbConn.Execute "COMMIT"
'L'instruction s'est effectuée en mode syncrone car la connexion est déjà établie et le serveur ne retourne pas de données,
'l'exécution étant quasiement immédiate il est inutile d'effectuer une boucle d'attente.
End If

End Function

'------------------------------------------------------------------------
'-- Fonction Exemple qui retourne un Recordset sous forme d'un tableau
'-- en utilisant la connexion précédemment ouverte
'------------------------------------------------------------------------
Public Function GetDataRecord(ByVal sCommande As String, Optional ByRef MessageErreur As String) As Variant
Dim dbRecord As ADODB.Recordset
Dim i As Long
Dim j As Long
Dim iNbCols As Integer
Dim tabRec() As Variant
Dim DataType As ADODB.DataTypeEnum
Dim varVal As Variant
'
On Error Resume Next
'
'Vérifier si la connexion est active
If Not bLogginOk Then
MessageErreur = "Opération annulée, aucune connexion en cours."
'Retourne un tableau bi-dimentionnel vide afin de ne pas générer une erreur lors du traitement de la procédure appelante
ReDim tabRec(0, 0)
GetDataRecord = tabRec
Erase tabRec
Exit Function
End If
'Création de l'Objet recordset
Set dbRecord = New ADODB.Recordset
'Fixer le cache mémoire (2000 est en gal un bon compromis)
dbRecord.CacheSize = 2000
'Optonnel, permet de limiter le nombre d'enregistrements retournés, équivaut à <Top(10 000)> pour SqlServer , <WHERE ROWNUM <10001)> pour Oracle et <TOPMOST 10000> pour MySql
dbRecord.MaxRecords = 10000
dbRecord.Open sCommande, dbConn, adOpenStatic, adLockReadOnly, adAsyncExecute
'Boucle d'attente jusqu'à ce que le serveur renvoi des enregistrements ou une erreur
Do While dbRecord.State > 1
'Attention, c'est l'objet connexion qui se charge de renvoyer les erreurs éventuelles
If dbConn.Errors.Count > 0 Then
If dbConn.Errors(0).Number <> 0 And dbConn.Errors(0).NativeError <> 0 Then
'Ajouter Ici le code personnalisé du traitement des erreurs
MessageErreur = dbConn.Errors(0).Number & "/" & dbConn.Errors(0).NativeError & "/" & dbConn.Errors(0).Description
'Destruction de l'objet recordset et Libération mémoire.
Set dbConn = Nothing
'Sortie prématurée de la fonction
Exit Function
End If
End If
'Rendre temporairement la main au système
DoEvents
Loop
'A ce niveau, le Curseur est valide, il reste à trater les enregistrements retournés.
If dbRecord.RecordCount > 0 Then
'Mémoriser le nombre de colonnes (champs)
iNbCols = dbRecord.Fields.Count
'Redimentionner le tableau des enregistrements
ReDim tabRec(1 To iNbCols, 1 To dbRecord.RecordCount)
'Sepositionner sur le premier enregistrement
If Not dbRecord.BOF Then dbRecord.MoveFirst
Do While Not dbRecord.EOF
'Redonner temporairement la main au systeme
DoEvents
For i = 0 To iNbCols - 1
DataType = dbRecord.Fields(i).Type
varVal = dbRecord.Fields(i).Value
'Traitement des valeurs nulles à modifier en fonction d'une utilisation spécifique
' Attention, pour SqlServer Vide et null sont différents alors que Oracle considère vide égal à null
If IsNull(varVal) Then varVal = ""
'traitement des valeurs en fonction du type et d'une utilisation ultérieure
Select Case DataType
'-- traitement des numériques
Case adInteger, adBigInt, adSmallInt, adNumeric, adSingle, adDecimal, adDouble, adCurrency
'
'-- Traitement des Chaînes
Case adChar, adVarChar, adVarWChar, adWChar
'
'-- Traitement des dates
Case adDate, adDBDate, adDBTime, adDBTimeStamp
'Pour une fois, les difficultées ne viendront pas d'Oracle dans le traitement des dates,
' La gestion est enfantine et repose sur une fonction qui rappelle celle utilisée en VB6
'Il suffit d'appeler la fonction To_Date(Nom_De_Variable,'DD/MM/YYYY H24,NN,SS') et le tour est joué.
'Par contre, avec Sql Serveur c'est un casse-tête chinois, des fonctions dans tous les sens, des formats prédéfinis en en plus finir
' et pour couronner le tout des types incompatibles en fonction de la version du serveur (Sql2000, 2005,2008) (SmallDateTime devenu obsolète par exemple).
' mais peut-être suis-je idiot et n'ai-je rien compris à la philosophie des dates Microsoft.
'
'Pour faire simple personnellement j'utilise la fonction Cast qui a l'avantage d'exister en Oracle
'Exemple pour comparer une date en base avec une date dans une close Where:
'Dim MaDate as date
'dim MaRequete as string
'Dim MaValeur as variant
'Dim Nom_Table as string
'Dim Nom_De_Colonne as string 'MaRequete "SELECT " & MaValeur & " FROM " & Nom_Table & " Where Cast(" & Nom_De_Colonne & " AS DateTime) CAST('" & Format(MaDate,"dd/mm/yyyy hh:nn:ss.000") & "' AS DateTime & ")"
'
'-- Traitement des types spéciaux (images, texte long, binaires, blog etc...)
Case Else
'
End Select
tabRec(i + 1, dbRecord.Bookmark) = varVal '
Next
'Se positionner sur l'enregistrement suivant si la fin du recordset n'est pas atteinte
If Not dbRecord.EOF Then dbRecord.MoveNext
Loop
Else
'Retourne un tableau bi-dimentionnel vide afin de ne pas générer une erreur lors du traitement de la procédure appelante
ReDim tabRec(0, 0)
End If
'transfert du tableau local
GetDataRecord = tabRec
'libération mémoire
Erase tabRec
End Function

'//////////////////////////////////////////////////////////////////////
'-- Dans une Form l'appel des fonctions est du type:
'//////////////////////////////////////////////////////////////////////
Sub EssaiRecordSet()
'Declaration des Variables Locales
Dim Message_Erreur As String
Dim tabRecordSetResult() As Variant
Dim iNbCols As Integer
Dim lNbEnregs As Long
Dim i As Long
Dim j As Integer
'
'On considère que l'utilisateur a renseigné
' le UserId, PassWord, le type de base, le nom du serveur, le nom de la base et le port d'écoute
' dans des Controles de saisie adaptés
''dbType = Base_Microsoft_Sql_Server
''dbUserName = "Mon_User"
''dbPassword = "Mon_Mot_De_passe"
''dbServeur = "127.0.0.1"
''dbDataBase = "Nom_De_La_Base"
''dbPort=1433
' Ouverture de la connexion:
Message_Erreur = ConnexionBase()
If Message_Erreur = "" And bLogginOk Then
'tabRecordSetResult = GetDataRecord("Select * from Nom_Table", Message_Erreur)
tabRecordSetResult = GetDataRecord("Select * from bi_article", Message_Erreur)
If Message_Erreur = "" Then
iNbCols = UBound(tabRecordSetResult, 1)
lNbEnregs = UBound(tabRecordSetResult, 2)
'Boucle des enregistrements
For i = 1 To lNbEnregs
'Boucle des colonnes (Champs)
For j = 1 To iNbCols
''Traitement
Next j
Next i
End If
End If
'Si la connexion n'est plus utilisée elle est fermée
If Not dbConn Is Nothing Then
If dbConn.State >= 0 Then dbConn.Close
Set dbConn = Nothing
End If
'//////////////////////////////////////////////////////////////////////
End Sub
navyconchita Messages postés 31 Date d'inscription mercredi 10 novembre 2010 Statut Membre Dernière intervention 12 janvier 2012
13 août 2011 à 11:33
Merci beaucoup pour ce commentaire si instructif et pragmatique. j'en tiendrai effectivement compte.
cs_ghuysmans99 Messages postés 3982 Date d'inscription jeudi 14 juillet 2005 Statut Membre Dernière intervention 30 juin 2013 16
12 août 2011 à 22:18
4) Pas de type; pour faire propre, le déclarer en "Static" dans la seule sub où il est utilisé.
14) "If Len(x)=0 Then" serait mieux, mais bon ce n'est pas le plus grave
55-56) Pas de type -> VbMsgBoxResult
60) "Unload Me" est un peu moins brutal ...
62) Pas besoin de "rep2" car on ne garde quand même pas "rep"
65-68) "Case vb..." suffit
69-70) Plus propre de faire "tonObjet.Text=..." (aussi une question de cohérence)
80) cf 62)
85) cf 55-56)
96) où est gérée l'erreur ensuite ?
127) Il ne faut jamais utiliser de chemins en dur ! <<Shell(App.Path & "\ArretAltbank.bat", vbHide)>> est mieux.
127) Quand on y regarde de plus près, le batch ne fait qu'un TSKILL. Autant donner directement cette commande à Shell()
129~135) Remplacer par ceci <<Set uti = cn.Execute("SELECT coduti FROM utilisateur WHERE coduti='" & Replace$(CboNomUt.Text, "'", "''") & "'">>
136-150) Remplacer par un "If uti.EOF" et "End If" ; Pourquoi valider APRES la requête SQL ?
137) cf 14)
143-144) "ElseIf", non ?
144) A quoi bon refaire une comparaison ? Déjà fait dans le WHERE !
145) AAAAAAAAARGH un GOTO où il ne faut pas !
147) RE-AAAAAARGH un autre GOTO !
165) cf 60)
182-187) Remplacer par ceci <<Set uti = cn.Execute("SELECT coduti FROM utilisateur WHERE coduti NOT IN ('long','wata','deja','AUTO','adm')")>>

90~113) Mettre ce code-ci à la place ...
Dim cond As String : cond = "coduti='" & Replace$(CboNomUt.Text, "'", "''") & "'"
Set uti = cn.Execute("SELECT connecter FROM utilisateur WHERE " & cond)
Select Case uti("connecter")
Case "O"
cn.Execute "UPDATE utilisateur SET connecter='N' WHERE " & cond
MsgBox "L'utilisateur a été déconnecté avec succcès. Il peut continuer à travailler dans Altbank !", vbInformation, "Déconnexion Altbank"
Case "N"
MsgBox "Cet utilisateur n'a pas besoin d'être déconnecté et peut donc travailler avec Altbank.", vbInformation, "Déconnexion Altbank"
End Select
uti.Close : Set uti = Nothing
End 'vraiment nécessaire ?!

En résumé, il faut absolument que tu comprennes ces modifs (et que tu les intègres) pour t'améliorer, là c'est vraiment grave ...
Rejoignez-nous