Requète SQL dynamique en Excel VBA.

Version imprimable

Bonjour,

J'ai un souci avec une requête que je passe à un serveur Oracle via ODBC.
Le souci, c'est que j'ai toujours l'erreur suivante :
"Erreur générale ODBC"

Le code de ma fonction est le suivant :

Code:

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
 
 
 
Public Function FctExecOracle1( _
        ByVal StrUsr1 As String, _
        ByVal StrPwd1 As String, _
        ByVal StrNomBase As String, _
        ByVal StrRequete As String, _
        ByVal WbkActif1 As Workbook, _
        ByVal StrFeuilleDestination As String, _
        Optional ByVal StrCelluleDestination As String = "A1") As Boolean
 
    Dim SheetActif      As Worksheet
    Dim StrBaseConnexion As String
 
    Dim BoolResult      As Boolean
    Dim StrNomProcApp   As String   'Stockage de la procédure appelante
 
On Error GoTo Erreur
 
    StrNomProcApp = NomProc
    NomProc = "FctExecOracle1"  'Gestion des erreurs (procédure en cours)
    BoolResult = False
 
    Set SheetActif = WbkActif1.Worksheets(StrFeuilleDestination)
 
    SheetActif.Visible = True
    SheetActif.Activate
    Selection.ClearContents
 
    StrBaseConnexion = "ODBC;DRIVER={Microsoft ODBC pour Oracle}" & _
            ";UID=" & StrUsr1 & _
            ";PWD=" & StrPwd1 & _
            ";SERVER=" & StrNomBase
 
    With ActiveSheet.QueryTables.Add(Connection:=StrBaseConnexion, _
          Destination:=Range(StrCelluleDestination), Sql:=StrRequete)
        .FieldNames = True
        .AdjustColumnWidth = True
        .Refresh (False) 'attend le résultat avant de continuer la procédure
    End With
 
 
    BoolResult = True
 
Sortie:
    Set SheetActif = Nothing
 
    FctExecOracle1 = BoolResult
    Exit Function
 
Erreur:
Resume
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "Import de données"
    GoTo Sortie
 
End Function

Un autre essai impliquant un autre driver ODBC m'a donné le même résultat (c'est sans doute une grosse boulette sans doute plus grosse que moi, mais je ne la vois pas).

Le deuxième essai a été réalisé en remplaçant le contenu de la fonction ci-dessus par le bout de code suivant (trouvé ailleur sur le Net:aie:).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
 
    INSTANCE = StrNomBase '"Exemple"
    User = StrUsr1 'scott"
    MDP = StrPwd1 '"tiger"
    PL_SQL = StrRequete '"select * from all_all_tables"
    DRV_ODBC = "Oracle ODBC Driver"
 
'Connexion
 
    With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DRIVER={" & DRV_ODBC & "};SERVER=" & INSTANCE & ";UID=" & User & ";PWD=" & MDP & ";DBQ=" & INSTANCE & ";DBA=W;APA=T;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST= T;FRL=F" _
        ), Array(";MTS=F;CSR=F;PFC=10;TLO=O;")), Destination:=ActiveCell)
        .CommandText = PL_SQL
        .Refresh BackgroundQuery:=False
    End With

En fait il plante sur le "refresh".

Est-ce que vous pourriez m'aider à voir ce qui cloche, car là j'avoue que je m'arrache un peut le cheveux.

Par avance merci.

Marco.

22/12/2009, 10h16
cotmar

Bonjour à toutes et à toutes,

Pardonnez moi d'insister, mais il ne me reste pas beaucoup de jours avant la fin de mon projet et cela me bloque.

Manque t il des informations ou bien la description de mon problème n'est-elle pas complète ?

Si c'était le cas, je me ferais un plaisir de la compléter.

Par avance je vous remercie.

Marco.

Ajout de commentaires dans le code VB...

Bonjour,

Alors je viens de trouver la solution... Et en fait c'est en partie la faute de ma fonction et en partie la faute de ma requête SQL (je vais expliquer un peut plus loin).

En fait pour diverse raison, j'avais besoin d'avoir une requête SQL qui soit entièrement paramétrable.

J'ai donc décomposé les différents éléments dans une feuille Excel. Au moment de lancer, je regarde les paramétrès et je "recolle" les morceaux jusqu'à obtenir une chaîne SQL complète (mon Select).

C'était la faute de ma requête SQL car dans ma "grande hâte", je faisais un "order by" sur des champs, sans faire le "group by" sur ces mêmes champs. :aie:

Ensuite dans le dialogue entre Excel et Oracle, entre les deux, je récupère une String (mon Select) dans lequel un certain nombre de choses sont entre doubles quotes d'une part et d'autre part, Je récupère des caractères de contrôle de Excel. J'ai donc fait 2 fonction de filtre pour enlever les doubles- "double quote" et pour enlever tous les caractères bizaroïdes issus d'Excel.

Code:

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
 
 
 
 
Public Function FctExecOracle1( _
        ByVal StrUsr1 As String, _
        ByVal StrPwd1 As String, _
        ByVal StrNomBase As String, _
        ByVal StrRequete As String, _
        ByVal WbkActif1 As Workbook, _
        ByVal StrFeuilleDestination As String, _
        Optional ByVal StrCelluleDestination As String = "A1") As Boolean
 
    Dim SheetActif      As Worksheet
    Dim StrBaseConnexion As String
    Dim StrCmdSQL       As String
 
    Dim BoolResult      As Boolean
    Dim StrNomProcApp   As String   'Stockage de la procédure appelante
 
On Error GoTo Erreur
 
    StrNomProcApp = NomProc
    NomProc = "FctExecOracle1"  'Gestion des erreurs (procédure en cours)
    BoolResult = False
 
    Set SheetActif = WbkActif1.Worksheets(StrFeuilleDestination)
 
    SheetActif.Visible = True
    SheetActif.Select
    Selection.ClearContents
    SheetActif.Range(StrCelluleDestination).Activate
 
    StrBaseConnexion = "ODBC;DRIVER={Microsoft ODBC pour Oracle}" & _
            ";UID=" & StrUsr1 & _
            ";PWD=" & StrPwd1 & _
            ";SERVER=" & StrNomBase
 
    StrCmdSQL = FctFiltreCaractere(StrRequete)
    StrCmdSQL = FctFiltreQuote(StrRequete)
 
'/!\ D : Pour tester => chaîne SQL reconstituée, donnée ici à titre d'exemple...
'    StrRequete = "SELECT sum(nvl(a0,0)) ""A0"", sum(nvl(a1,0)) ""A1"", sum(nvl(a2,0)) ""A2"", sum(nvl(a3,0)) ""A3"", sum(nvl(a4,0)) ""A4"", sum(nvl(a5,0)) ""A5"", sum(nvl(a6,0)) ""A6"", sum(nvl(autoa0,0)) ""Auto A0"", sum(nvl(autoa1,0)) ""Auto A1"", sum(nvl(autoa2,0)) ""Auto A2"", sum(nvl(autoa3,0)) ""Auto A3"", sum(nvl(autoa4,0)) ""Auto A4"", sum(nvl(autoa5,0)) ""Auto A5"", sum(nvl(autoa6,0)) ""Auto A6"", sum(nvl(b0,0)) ""B0"", sum(nvl(b1,0)) ""B1"", sum(nvl(b2,0)) ""B2"", sum(nvl(b3,0)) ""B3"", sum(nvl(b4,0)) ""B4"", sum(nvl(b5,0)) ""B5"", sum(nvl(b6,0)) ""B6"", sum(nvl(autob0,0)) ""Auto B0"", sum(nvl(autob1,0)) ""Auto B1"", sum(nvl(autob2,0)) ""Auto B2"", sum(nvl(autob3,0)) ""Auto B3"", sum(nvl(autob4,0)) ""Auto B4"", sum(nvl(autob5,0)) ""Auto B5"", sum(nvl(autob6,0)) ""Auto B6"", sum(recette) ""Recette"", sum(cap_a) ""Cap A"", sum(cap_b) ""Cap B"", sum(traf_a + traf_b) ""Trafic total"" FROM tog_base_resa WHERE (dpt_date between '01/07/08' and '30/07/08')" & _
'                "and ENTITE in ('PARISRHONE ', 'RHONEPARIS', 'PAITALIE', 'ITALIEPA', 'PARISALPES', 'ALPESPARIS', 'PAGRENOBLE', 'GRENOBLEPA', 'PAGENEVE', 'GENEVEPA', 'PABOUR', 'BOURPA', 'PASUIS', 'SUISPA') and leg_orig=peak_leg order by entite, dpt_date, niveau, type_train"
'/!\ F : Pour tester
 
    With ActiveSheet.QueryTables.Add(Connection:=StrBaseConnexion, _
          Destination:=Range(StrCelluleDestination), Sql:=CStr(StrCmdSQL))
        .FieldNames = True
        .AdjustColumnWidth = True
        .Refresh (False) 'attend le résultat avant de continuer la procédure
    End With
 
    BoolResult = True
 
Sortie:
    Set SheetActif = Nothing
 
    FctExecOracle1 = BoolResult
    Exit Function
 
Erreur:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, CstApplication
    GoTo Sortie
 
End Function

Et mes fonction de filtrage de la String :

Code:

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
 
 
 
 
Public Function FctFiltreCaractere(ByVal MaVal As Variant) As String
    Dim LngPos              As Long
    Dim LngCodCar           As Long
    Dim StrLeCar            As String
    Dim BoolFlagNumerique   As Boolean
    Dim BoolResult          As Boolean
    Dim StrNomProcApp       As String   'Stockage de la procédure appelante
    Dim StrConcat           As String
 
    For LngPos = 1 To Len(MaVal)
        StrLeCar = Mid(MaVal, LngPos, 1)
        LngCodCar = Asc(Mid(MaVal, LngPos, 1))
        If (LngCodCar >= 33 Or LngCodCar <= 126) Then
            BoolFlagNumerique = True 'False
            StrConcat = StrConcat & StrLeCar
        End If
    Next LngPos
 
    FctFiltreCaractere = StrConcat
 
End Function
 
Public Function FctFiltreQuote(ByVal MaVal As Variant) As String
    Dim LngPos              As Long
    Dim LngCodCar           As Long
    Dim LngCodCar1           As Long
    Dim StrLeCar            As String
    Dim StrLeCar1           As String
    Dim BoolFlagNumerique   As Boolean
    Dim BoolResult          As Boolean
    Dim StrNomProcApp       As String   'Stockage de la procédure appelante
    Dim StrConcat           As String
 
    For LngPos = 1 To Len(MaVal)
        StrLeCar = Mid(MaVal, LngPos, 1)
        StrLeCar1 = Mid(MaVal, LngPos + 1, 1)
        LngCodCar = Asc(Mid(MaVal, LngPos, 1))
        LngCodCar1 = Asc(Mid(MaVal, LngPos, 1))
        If (LngCodCar = 34 And LngCodCar1 = 34) Then
        'Si les deux caractères consécutifs sont des doubles quote, je ne prends que le premier
            StrConcat = StrConcat & Chr(34)
            LngPos = LngPos + 1
        Else
            StrConcat = StrConcat & StrLeCar
        End If
    Next LngPos
 
    FctFiltreQuote = StrConcat
 
End Function

J'espère que ces fonctions pourront un jour être utiles à quelqu'un.

A bientôt et merci de votre lecture.

Marco.