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 92 93 94 95 96 97 98
| Option Explicit
Public cN As ADODB.Connection
Public rs As ADODB.Recordset
Public Function conNect() As Boolean
On Error GoTo conNect_Err
Set cN = New ADODB.Connection
cN.ConnectionString = "Provider=msdaora;Data Source=IOUI;User Id=xxxxxx;Password=xxxxxx;"
cN.Open
conNect = True
Exit Function
conNect_Err:
MsgBox Err.Number & vbCr & Err.Description
conNect = True
End Function
Public Function DeconNect() As Boolean
On Error Resume Next
cN.Close
Set cN = Nothing
End Function
Private Sub Workbook_Open()
Dim strSQL As String
Dim i As Integer
Dim j As Integer
On Error GoTo Workbook_Open_Err
Feuil1.Cells(1, 1) = "id_indice"
Feuil1.Cells(1, 2) = "cote"
If conNect() = True Then
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
strSQL = ""
strSQL = strSQL & "select cote.indice ind99, "
strSQL = strSQL & " cote.cote_actuelle cot99 "
strSQL = strSQL & " from t_detail_vin pr, "
strSQL = strSQL & " type_vin vin, "
strSQL = strSQL & " (select ind.id_tvin, "
strSQL = strSQL & " ind.milesime millesime, "
strSQL = strSQL & " c.cote cote_actuelle, "
strSQL = strSQL & " ind.id_indice indice "
strSQL = strSQL & " from t_indices ind, "
strSQL = strSQL & " cote_annuelle c "
strSQL = strSQL & " where ind.id_indice = c.id_indice"
strSQL = strSQL & " and ind.format in('Bouteille') "
strSQL = strSQL & " and c.annee='2010' "
strSQL = strSQL & " and ind.id_indice not in ('1','2','3') "
'strSQL = strSQL & " and ind.id_indice < '50') cote "
strSQL = strSQL & " ) cote "
strSQL = strSQL & " where vin.id_tvin = pr.id_tvin "
strSQL = strSQL & " and pr.milesime = cote.millesime "
strSQL = strSQL & " and vin.id_tvin=cote.id_tvin "
strSQL = strSQL & " and vin.proprietaire not in ('Indifferent') "
strSQL = strSQL & " and vin.proprietaire is not null "
strSQL = strSQL & " order by cote.indice"
rs.Open strSQL, cN, adOpenForwardOnly, adLockOptimistic
If rs.RecordCount > 0 Then
j = 1
i = 1
Do While Not rs.EOF And Not rs.BOF
i = i + 1
Feuil1.Cells(i, j) = rs("ind99")
Feuil1.Cells(i, j + 1) = rs("cot99")
rs.MoveNext
Loop
End If
DeconNect
Else
'blablabla
End If
Exit Sub
Workbook_Open_Err:
MsgBox Err.Number & vbCr & Err.Description
End Sub |
Partager