Bonjour,

Je souhaite faire une petite interface dans excel me permettant de créer des requètes SQL afin d'extraire des données de l'AS400

J'ai trouver ce code permettant d'extraire les données :

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Private Sub CmdGO_Click()
Dim wrqt As String
Dim was400 As String
wrqt = UCase(Trim(Range("SQL").Value)) 'UCase(Trim(TextSql.text))
Debug.Print wrqt
was400 = UCase(Trim(TextAS.text))
If Len(wrqt) < 10 Then
    MsgBox "Requête incorrecte !"
    Exit Sub
End If
If Left(wrqt, 6) <> "SELECT" Then
    MsgBox "la requête doit commencer par 'SELECT' !"
    Exit Sub
End If
If Len(was400) < 3 Then
    MsgBox "AS400 incorrect"
    Exit Sub
End If
Conect wrqt, was400
End Sub
 
'Routine principale :
Public Sub Conect(wrqt As String, was400 As String)
Dim Con As New ADODB.Connection
Dim Cmd As New ADODB.Command
Dim Rs As ADODB.Recordset
Dim txtc As String
 
Dim rowCount As Integer
Dim colCount As Integer
Dim text As String
Dim Number As Long
Dim val As Variant
On Error GoTo FINI
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
oldStatusBar = Application.DisplayStatusBar
Application.StatusBar = True
Application.StatusBar = "Pierre BERTAUD travaille pour vous..."
'** Indiquer le data source, le user et le MdP qui vous conviennent
txtc = "provider=IBMDA400;data source=" & was400 & "; ;;"
Con.Open txtc
 
Set Cmd.ActiveConnection = Con
Cmd.CommandText = wrqt
Set Rs = Nothing
Set Rs = Cmd.Execute()
rowCount = 4
'Sheets.Item(2).Range(Cells(rowCount + 1, 20), Cells(4000, 20)).ClearContents
    Sheets("Résultat").Select
    Range("A4:J4000").Select
    Selection.ClearContents
 
For colCount = 0 To Rs.Fields.Count - 1
    Sheets.Item(2).Cells(rowCount, colCount + 1).Value = Rs.Fields(colCount).Name
    Sheets.Item(2).Cells(rowCount, colCount + 1).Font.Bold = True
Next colCount
While Not Rs.EOF
    rowCount = rowCount + 1
    For colCount = 0 To Rs.Fields.Count - 1
        If Rs.Fields(colCount).ActualSize = -1 Then
            text = ""
        Else
            val = Rs.Fields(colCount).Value
            If VarType(val) = vbNull Then
                text = ""
            Else
                text = val
            End If
        End If
    Sheets.Item(2).Cells(rowCount, colCount + 1).Value = text
    Next colCount
    Rs.MoveNext
Wend
 
Set Rs = Nothing
Con.Close
Sheets.Item(2).Cells.Columns.AutoFit
Sheets.Item(2).Activate
Sheets.Item(2).Cells(1, 1).Activate
FINI:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
'MsgBox Cmd.Parameters.Count
If Len(Err.Description) > 0 Then
    MsgBox Err.Description
End If
 
End Sub
Donc je sais déja comment me connecter, seulement afin de pouvoir construire dynamique mon SQL je dois pouvoir lister les tables des bibliothèques qui m'intéresse ainsi que les champs de ces tables!

Est-ce que cela vous semble possible ?