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
| Sub RequeteClasseurFerme()
Dim Source As ADODB.Connection
Dim Fichier As String
Dim ADOCommand As ADODB.Command
Dim Feuille As String
Dim NomFeuille As String
Dim Rst As ADODB.Recordset
ShDatas.Range("A2:D65536").Clear 'on fait un RAZ
'Définit le classeur fermé servant de base de données
Fichier = "\\Stg07\13012013.xls"
'Nom de la feuille dans le classeur fermé
NomFeuille = "Feuil1"
'Adresse de la cellule contenant la donnée à récupérer
Dim Cellule As String
Cellule = "A1:C1000"
Set Source = New ADODB.Connection
'--- Connection ---
With Source
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & Fichier & _
";Extended Properties=Excel 8.0;"
.Open
End With
'-----------------
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT COURRIER, F2, login FROM [" & Feuille & Cellule & "] where login is not null"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Dim nb As Integer
nb = Rst.RecordCount
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
'******************************************************
Dim Arr() ' Dim Arr(3, 400)
ReDim Arr(nb, 3)
'***********************************************************************
Dim aa As Integer
Dim index_arr As Integer
Rst.MoveFirst
aa = 1
index_arr = 1
While Not (Rst.EOF)
If Rst.Fields(2) <> "" Then
Arr(index_arr, 1) = Rst.Fields(0)
Arr(index_arr, 2) = Rst.Fields(1)
Arr(index_arr, 3) = Rst.Fields(2)
index_arr = index_arr + 1
End If
Rst.MoveNext
aa = aa + 1
Wend
Rst.Close
'***********************************************************************
Source.Close '--- Fermeture connexion ---
Set Source = Nothing 'destruction de l'objet
End Sub |
Partager