Bonjour ,

je suis entrain de faire une extraction de données à partir de ma base Oracle sous Excel on cliquant sur un bouton extract. le problème que ça met beaucoup de temps pour faire une extraction de 60000 ligne et la Feuil Excel m'affiche toute en haut à gauche nom_de_fichier.xlsm (Ne répond pas) (sachant bien que ma requête et très longue et il y a beaucoup de jointure entre les tables et quand je fais Cells(10, 10).Value = Sql la requête que j'obtiens dans la cellule (10,10) je l’exécute sous SQLDEV et marche bien) ,il y a quelques jours l'extraction se fait en quelques minutes .
j'aimerai bien savoir si je pourrai optimiser le code (ci-joint) afin diminuer la durée d’extraction.
je vous remercie d'avance .


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
 
Private Sub CommandButton1_Click()
 
Dim intResult
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
 
'Dim query As String
Dim Sql As String
 
Dim d1 As String
Dim d2 As String
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
 
con.ConnectionString = "Driver={Microsoft ODBC for Oracle}; " & _
"CONNECTSTRING=(DESCRIPTION=" & _
"(ADDRESS=(PROTOCOL=TCP)" & _
"(HOST=XXXXXXXX)(PORT=xxxx))" & _
"(CONNECT_DATA=(SID=XXXX))); uid=XXXXX; pwd=XXXXX;"
con.Open
 
If (con.State = 1) Then
d1 = InputBox("Date au format YYYY/MM/DD", "Entrez Deb", Format(Date, "YYYY/MM/DD"))
d2 = InputBox("Date au format YYYY/MM/DD", "Entrez Fin", Format(Date, "YYYY/MM/DD"))
If d1 <> "" Then
  If Not IsDate(d1) Then MsgBox "Pas une date": Exit Sub
  Else
   MsgBox "Vous devez date": Exit Sub
 End If
 
If d2 <> "" Then
    If Not IsDate(d2) Then MsgBox "Pas une date": Exit Sub
  Else
   MsgBox "Vous devez date": Exit Sub
 End If
StartDate = Format(d1, "yyyymmdd")
EndDate = Format(d2, "yyyymmdd")
Sql = "select    requête ," & vbCrLf
Sql = Sql & "   requêterequêterequête," & vbCrLf
Sql = Sql & "  requêterequêterequêterequête," & vbCrLf
........
...........
...........
 
rs.Open Sql, con
 
If rs.State = 1 Then
                If Not (rs.EOF) Then
                       For Each qf In rs.Fields
                       Range("a5").Offset(0, coloffset).Value = qf.Name
                       coloffset = coloffset + 1
                       Next qf
                       Set Wks = Sheets("Feuil1")
                       Sheets("Feuil1").Range("A6").CopyFromRecordset rs
 
                End If
                rs.Close
        End If
        Else
            intResult = MsgBox("Could not connect to the database.  Check your user name and password." & vbCrLf & Error(Err), 16, "Oracle Connection Demo")
End If
 
con.Close
 
With Worksheets("Feuil1")
 
derl = .Range("A1048576").End(xlUp).Row
Tbl = .Range("A5:X" & derl)
 
End With
 
 
End Sub