Importer données sql dans tableau VBA
Bonjour à tous,
J'espère que vous bien fêter durant cette période de noël.
Je ne trouve malheureusement nul part des réponses à mon problème.
Je souhaiterais récupérer des données que j'ai sur SQL Server et les avoir dans un tableau vba.
J'arrive à copier le retour de ma requête sql sur un feuille EXCEL, mais avoir toute un colonne dans un tableau je n'arrive malheureusement pas.
Avez-vous des conseils ?
je vous joins un fichier que j'ai commencé. Cependant, vous n'aurez pas accès à ma BD.
Une très bonne journée.
Maurer
Bonjour,
Avec mes meilleurs vœux, voici quelques fonctions que j'utilisent pour SQL et dont tu vas pouvoir t'inspirer.
La première permet de récupérer le schéma d'une base, regarde bien la boucle...
' ©----------------------------------
' 017 Structure d'une base de données
' Variables : Serveur, Base
' -----------------------------------
Public Sub SQL_GetSchema()
Dim Requete As String
Dim T As String
Dim i As Integer
'SQL_OpenDB
'Requete = "Select s.name as [Schema], o.type_desc As [Type], o.name As [Name]"
'Requete = Requete + " From sys.all_objects o"
'Requete = Requete + " inner join sys.schemas s on s.schema_id = o.schema_id"
'Requete = Requete + " Where o.type in ('U', 'V', 'P') -- tables, views, and stored procedures"
'Requete = Requete + " Order by s.Name"
'Set rs = SQLRequeteEx(Requete)
'Quick True
i = 1
Set rs = cnn.OpenSchema(adSchemaTables)
While Not rs.EOF
Selection.Offset(i + 2, 0) = rs!TABLE_NAME
rs.MoveNext
i = i + 1
Wend
'Quick False
'SQL_CloseDB
End SubCette fonction récupère le nom des champs d'une table :
' ©--------------------------
' Structure d'une table DB
' ---------------------------
Sub NomsChampBD(ByVal Table As Range)
On Error Resume Next
Dim i As Integer
'Quick True
' SQL_OpenDB
'MsgBox (Table.Cells.Address)
Set R = New ADODB.Recordset
R.Open "select * from " & Table.Cells.Value, cnn
R.MoveFirst
For i = 0 To R.Fields.Count - 1
Table.Offset(i + 2, 0) = R.Fields(i).Name
' Table.Offset(i + 2, 1) = R.Fields(i).Type
' Table.Offset(i + 2, 2) = R.Fields(i).Precision
' Table.Offset(i + 2, 3) = R.Fields(i).Value
Next i
' SQL_CloseDB
' Quick False
End SubVoici un Select :
'Dans une cellule, =SQLGet("Select...")
Function SQLGet(RequeteSQL As String)
On Error Resume Next
Dim TablesSchema As ADODB.Recordset
Dim ColumnsSchema As ADODB.Recordset
Dim champ As ADODB.Field
Dim E As Long
Application.Volatile True
'SQL_OpenDB ' Ouvrir la base
Set R = New ADODB.Recordset
R.Open RequeteSQL, cnn
R.MoveFirst
SQLGet = R.Fields.Item(0)
'SQL_CloseDB ' Fermer la base
End FunctionIci, une fonction pour les "update" avec rollback transactionnel
' ©-------------------
' Requete SQL Update
' --------------------
Function SQLUpdate(RequeteSQL As String)
On Error GoTo CleanFail
Dim cmd As ADODB.Command ' commande SQL
' SQL_OpenDB
' Quick True
cnn.BeginTrans ' Dialogue Transactionnel
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cnn
cmd.CommandText = RequeteSQL
cmd.Execute
cnn.CommitTrans
CleanExit:
' SQL_CloseDB
' Quick False
Exit Function
CleanFail:
cnn.RollbackTrans
MsgBox "Désolé, une erreur est survenue."
Debug.Print Err.Number, Err.Description
Resume CleanExit
End Functionet un select avec retour de plusieurs données comme ça par exemple :
' ©----------------
' RequeteEx SQL
' -----------------
Function SQLRequeteEx(ByVal RequeteSQL As String) As ADODB.Recordset
On Error Resume Next
' Exemple RequeteSQL = "Select Max(OPKNNUMERO) from Opportun"
Set R = New ADODB.Recordset
R.Open RequeteSQL, cnn
R.MoveFirst
Set SQLRequeteEx = R
End FunctionCette fonction contient toutes les données de la requête
Donc pour associer les données aux cellules, un truc du genre :
Set rs = SQLRequeteEx(uSQL)
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
'Debug.Print Rs.Fields(I).Name, Rs.Fields(I).Value
Cells(Lig,i).Value = rs.Fields(i).Value
Next
Lig = Lig + 1
rs.MoveNext
LoopJ'espère que ça te sera utile, bon courage !