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
| Sub RunQuery(Query As String, Connection_string As String)
Dim CON As Object 'ADODB.CONNECTION
Dim RST As Object 'ADODB.RECORDSET
Dim i As Integer 'Itérateur de boucle
Dim CurCalc As XlCalculation 'Mode de calcul actuellement actif
Dim Wb As Workbook
Dim Wks As Worksheet
Dim StartTime As Variant
On Error GoTo Err_hANdler_2:
Set CON = CreateObject("ADODB.Connection")
Set RST = CreateObject("ADODB.recordset")
Set Wb = ActiveWorkbook
'Ouverture de la connexion
CON.Open Connection_string
'Exécution de la requête
Set RST = CON.Execute(Query)
'Vérfie si le jeu d'enregistrement contient des données ou non
If RST.EOF And RST.BOF Then
Call MsgBox("Aucune donnée correspondant aux critères spécifiés n'a pu être trouvée", vbOKOnly, "Aucune donnée")
Exit Sub
End If
Set Wks = Wb.Worksheets.Add
CurCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Wks.Range("A2").CopyFromRecordset RST
'Inscription des noms de champs dans l'onglet
For i = 1 To RST.Fields.Count
Wks.Cells(1, i) = RST.Fields(i - 1).Name
Next i
CON.Close
Application.Calculation = CurCalc
Set CON = Nothing
Set RST = Nothing
MsgBox "Fin d'exécution. Aucune erreur détectée", vbInformation + vbOKOnly, "Fin d'exécution"
Exit Sub
Err_hANdler_2:
Call MsgBox(err.Number & " : " & err.Description, vbCritical, "Erreur survenue pendant l'exécution")
End Sub |
Partager