Bonjour,

Je souhaite extraire les données de tables Oracle dynamiquement: dans l'onglet Requetes, j'ai défini les requêtes à exécuter par table. Le résultat d'une requête est stocké dans un onglet du nom de la table extraite.
L'extraction se passe bien lorsque la requête retourne des données. En revanche lorsque la requête ne retourne pas de donnée j'obtiens l'erreur -2147467259 "Ce type de données n'est pas pris en charge." sur le Rs.open. Le traitement plante avant le test EOF.

Pouvez-vous svp m'éclairer sur ce problème?
Merci.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Sub extraction()
Dim cnx As New ADODB.Connection
Dim Sql As String
Dim Rs As New ADODB.Recordset
Dim Feuille As Worksheet
Dim NomTable As String
Dim ColTable As Integer  ' colonne contenant le nom des tables
Dim ColSql As Integer  ' colonne contenant les requêtes sql
Dim LigneMax As Integer ' ligne max des tables à extraire
Dim i, j As Integer
Dim wbs As Workbook, wfs As Worksheet
 
ColTable = 3
ColSql = 6
LigneMax = 38
Set wbs = ActiveWorkbook
 
' Paramètres de connexion
User = 'Valeur du user
PassWord = 'Valeur du mot de passe
Server = 'Valeur du serveur
 
GenereCSTRING = "Provider=MSDAORA.1;User ID=" & User & ";Data Source=" & Server & ";Password=" & PassWord
cnx.Open GenereCSTRING
 
'Vérifie que la connexion est bien fermée
  If cnx.State = adStateOpen Then
    cnx.Close
  End If
 
  'Connexion à la base de données
   cnx.Open GenereCSTRING
 
   For i = 2 To LigneMax
        Sheets("Requetes").Select
        NomTable = Sheets("Requetes").Cells(i, ColTable)
        Sql = Sheets("Requetes").Cells(i, ColSql)
 
        ' Test si il existe déjà un onglet pour la table : si il existe on le supprime avant de la recréer
        If (FeuilleInexistante(NomTable) = False) Then
                ' désactivation des messages de confirmation
                Application.DisplayAlerts = False
                Sheets(NomTable).Delete
                ' réactivation des messages de confirmation
                Application.DisplayAlerts = True
        End If
        Set Feuille = Sheets.Add(After:=Sheets(Sheets.Count))
        Feuille.Name = NomTable
 
        ' Exécution de la requête
         Rs.Open Sql, cnx ', 1, 3
 
        k = Rs.RecordCount
        ' Récupération des noms des colonnes
        If Rs.BOF And Rs.EOF Then
            Feuille.Cells(1, 1) = "Pas de données"
        Else
            For j = 1 To Rs.Fields.Count
                Feuille.Cells(1, j) = Rs.Fields(j - 1).Name
            Next j
 
            ' Récupération des données
            Feuille.Range("a2").CopyFromRecordset Rs
        End If
        Rs.Close
    Next i
 
AdoErrorLite:
       ' Get VB Error Object's information
       strTmp = strTmp & vbCrLf & "VB Error # " & Str(Err.Number)
       strTmp = strTmp & vbCrLf & "   Generated by " & Err.Source
       strTmp = strTmp & vbCrLf & "   Description  " & Err.Description
 
       MsgBox strTmp
 
End Sub