Bonjour a tous,

J'ai ce code qui permet d'interroger une base de donnée(ici des fichiers excels) avec le modèle ADO ( un grand merci à SilkyRoad). Le code fonctionne mais je compte le mettre dans une macro complémentaire. Elle est destiné à 6 utilisateurs, étant donné je n'ai jamais cela avant, est ce que vous sauriez comment ça va se comporter en cas de connexion multiple à un même fichier par exemple ? ou si le modèle ADO gère bien ce cas de figure

Si vous avez d'autres remarques, je suis preneuse

Mercii

Lucy

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
Public Sub extractionValeurCelluleClasseurFerme(ticker As String, champs As String, dateD As String, dateF As String, rng As Range)
    Dim Source As Object 'As ADODB.Connection
    Dim Rst As Object 'As ADODB.Recordset
    Dim ADOCommand As Object 'As ADODB.Command
    Dim Fichier As String, Feuille As String
    Dim listChamps() As String, nbChamps As Integer
    Dim champs0, champs1, champs2, champs3, champs4, champs5 As String
 
    Feuille = "Feuil1$"
    Fichier = "C:\Users\" & ticker & ".xlsx"
    listChamps() = Split(champs, ";")
    nbChamps = UBound(listChamps())
 
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + Fichier + ";Extended Properties=Excel 12.0;"
 
    Set ADOCommand = CreateObject("ADODB.Command")
    With ADOCommand
        .ActiveConnection = Source
        Select Case nbChamps
        Case 0
            champs0 = listChamps(0)
        .CommandText = "SELECT DateValue,[" & champs0 & "] FROM [" & Feuille & "] WHERE DateValue>= #" & dateD & "# And DateValue <= #" & dateF & "# GROUP BY DateValue,[" & champs0 & "]"
        Case 1
            champs0 = listChamps(0)
            champs1 = listChamps(1)
         .CommandText = "SELECT DateValue,[" & champs0 & "],[" & champs1 & "] FROM [" & Feuille & "] WHERE DateValue>= #" & dateD & "# And DateValue <= #" & dateF & "# GROUP BY DateValue,[" & champs0 & "],[" & champs1 & "]"
        Case 2
            champs0 = listChamps(0)
            champs1 = listChamps(1)
            champs2 = listChamps(2)
        .CommandText = "SELECT DateValue,[" & champs0 & "],[" & champs1 & "],[" & champs2 & "] FROM [" & Feuille & "] WHERE DateValue>= #" & dateD & "# And DateValue <= #" & dateF & "# GROUP BY DateValue,[" & champs0 & "],[" & champs1 & "],[" & champs2 & "]"
        Case 3
            champs0 = listChamps(0)
            champs1 = listChamps(1)
            champs2 = listChamps(2)
            champs3 = listChamps(3)
        .CommandText = "SELECT DateValue,[" & champs0 & "],[" & champs1 & "],[" & champs2 & "],[" & champs3 & "] FROM [" & Feuille & "] WHERE DateValue>= #" & dateD & "# And DateValue <= #" & dateF & "# GROUP BY DateValue,[" & champs0 & "],[" & champs1 & "],[" & champs2 & "],[" & champs3 & "]"
        Case 4
            champs0 = listChamps(0)
            champs1 = listChamps(1)
            champs2 = listChamps(2)
            champs3 = listChamps(3)
            champs4 = listChamps(4)
        .CommandText = "SELECT DateValue,[" & champs0 & "],[" & champs1 & "],[" & champs2 & "],[" & champs3 & "],[" & champs4 & "] FROM [" & Feuille & "] WHERE DateValue>= #" & dateD & "# And DateValue <= #" & dateF & "# GROUP BY DateValue,[" & champs0 & "],[" & champs1 & "],[" & champs2 & "],[" & champs3 & "],[" & champs4 & "]"
        Case 5
        .CommandText = "SELECT * FROM [" & Feuille & "] WHERE DateValue>= #" & dateD & "# And DateValue <= #" & dateF & "#"
        End Select
    End With
 
    Set Rst = CreateObject("ADODB.Recordset")
 
    'Rst.Open ADOCommand, , adOpenForwardOnly, adLockReadOnly
    Rst.Open ADOCommand, , adOpenStatic, adLockReadOnly
    Set Rst = Source.Execute(ADOCommand.CommandText)
 
    rng.Offset(1, 0).CopyFromRecordset Rst
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub