[XL-2010] Récupérer des informations d'un autre classeur sans l'ouvrir [Résolu]

[Manuel40]

Bonjour,

Je souhaite récupérer des informations dans plusieurs classeurs. Mon problème est qu'actuellement, j'ouvre mon classeur (l'ouverture de ce fichier prend un certain temps), je récupère les informations et je referme le fichier.

Existe-t-il un moyen de récupérer les information d'un fichier excel sans ouvrir son interface graphique?

Code actuel:

Code :

1
2
3
4
5
6
7
8
    Dim objWorkbookmain As Workbook, objWorkbook1 As Workbook
    Dim chemin As String
 
    Set objWorkbookmain = Application.ActiveWorkbook
    chemin = objWorkbookmain.Path
    Set objWorkbook1 = Application.Workbooks.Open(chemin & "\1.xls")
    objWorkbookmain.Sheets(1).Cells(1, 1) = objWorkbook1.Sheets(1).Cells(1, 1)
    objWorkbook1.Close

L'idée est de revoir la lignes 6. J'ai aussi essayé avec .Add mais le résultat est semblable.

Merci d'avance

Manu

[Theze]

Bonjour,

Voilà une piste. Exécute la proc "Test" en adaptant les valeurs. Attention, dans une même colonne les valeurs doivent être de même nature (string avec string ou long avec long, etc...) :

Code :

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
 
Sub ConnectCLasseur(ConnectCL As Object, _
                    Fichier As String, _
                    Optional Rs)
 
    Set ConnectCL = CreateObject("ADODB.Connection")
 
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
    'HDR > YES ou NO; entêtes de colonnes
    'IMEX > 1 lecture seule, 2 lecture/écriture
    ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 1;"""
 
End Sub
 
Function RecupValeur(Classeur As String, _
                     NomFeuille As String, _
                     Cellule As String) As Variant()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Champ As Object
    Dim Tbl() As Variant
    Dim I As Integer
 
    'connecxion
    ConnectCLasseur ConnectCL, Classeur, Rs
    'lecture
    With Rs
        .CursorType = 1
        .LockType = 3
        .Open "SELECT * FROM `" & NomFeuille & "$" & _
        Cellule & "` ", ConnectCL
 
        Do Until .EOF
 
            For Each Champ In .Fields
 
                I = I + 1
                ReDim Preserve Tbl(1 To I)
                Tbl(I) = Champ.Value
 
            Next
 
            .MoveNext
 
        Loop
 
        'ValeurCellule = .Fields(0).Value
 
    End With
 
    ConnectCL.Close
 
    RecupValeur = Tbl
 
    Set Rs = Nothing
    Set ConnectCL = Nothing
    Set Champ = Nothing
 
End Function
 
 
Sub Test()
 
    Dim Retour() As Variant
    Dim I As Integer
 
    Retour = RecupValeur("D:\Classeur.xls", _
                        "Feuil1", _
                        "B1:C22")
 
 
    For I = 1 To UBound(Retour)
        Debug.Print Retour(I)
    Next I
 
End Sub

Hervé.

[Manuel40]

J'ai malheureusement quelques colonnes dans lesquelles on retrouve du String et du Long.

J'ai tout de même une petite idée pour bidouiller le code pour extraire les informations quelque-soit le type d'information (qu'il soit en Long ou en String). Mais avant cela, je crois que je vais avoir besoin de relire quelques tutos sur MySQL.

Si ça intéresse quelqu'un je posterai mon code... Si j'y arrive...

En tout cas merci bien Theze.

[Philippe JOCHMANS]

Bonjour

Quelques informations complémentaires : Lire et écrire dans les classeurs fermés

Philippe

[Manuel40]

Merci, pour les informations Philippe. Je me permets donc de corriger le code de Theze. (voir ligne 15)
Attention! Le résultat de ces fonctions ne renvoie que des variables de type String.

Code :

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
Sub ConnectCLasseur(ConnectCL As Object, _
                    Fichier As String, _
                    Optional Rs)
 
    Set ConnectCL = CreateObject("ADODB.Connection")
 
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
    'HDR > YES ou NO; entêtes de colonnes
    'IMEX > 1 lecture seule, 2 lecture/écriture
    ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""
 
              ' ############ Ligne à l'origine ############
              '"Extended Properties=""Excel 8.0;HDR=NO;IMEX= 1;"""
              ' C'est juste l'espace entre le 'IMEX=' et le '1;' qui est en trop 
End Sub
 
Function RecupValeur(Classeur As String, _
                     NomFeuille As String, _
                     Cellule As String) As Variant()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Champ As Object
    Dim Tbl() As Variant
    Dim I As Integer
 
    'connecxion
    ConnectCLasseur ConnectCL, Classeur, Rs
    'lecture
    With Rs
        .CursorType = 1
        .LockType = 3
        .Open "SELECT * FROM `" & NomFeuille & "$" & _
        Cellule & "` ", ConnectCL
 
        Do Until .EOF
 
            For Each Champ In .Fields
 
                I = I + 1
                ReDim Preserve Tbl(1 To I)
                Tbl(I) = Champ.Value
 
            Next
 
            .MoveNext
 
        Loop
 
        'ValeurCellule = .Fields(0).Value
 
    End With
 
    ConnectCL.Close
 
    RecupValeur = Tbl
 
    Set Rs = Nothing
    Set ConnectCL = Nothing
    Set Champ = Nothing
 
End Function
 
 
Sub Test()
 
    Dim Retour() As Variant
    Dim I As Integer
 
    Retour = RecupValeur("D:\Classeur.xls", _
                        "Feuil1", _
                        "B1:C22")
 
 
    For I = 1 To UBound(Retour)
        Debug.Print Retour(I)
    Next I
 
End Sub

Et voilà, ça fonctionne...
Merci Theze et Philippe.