Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news: e0sy1Wm3FHA.3588@TK2MSFTNGP15.phx.gbl...
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news: C9377270-6214-4FA2-8382-937BBE4968F4@microsoft.com...
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news: e0sy1Wm3FHA.3588@TK2MSFTNGP15.phx.gbl...
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news: C9377270-6214-4FA2-8382-937BBE4968F4@microsoft.com...
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news: 5A8BC289-3DB8-424F-89B2-7024C035186D@microsoft.com...
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news: e0sy1Wm3FHA.3588@TK2MSFTNGP15.phx.gbl...
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news: C9377270-6214-4FA2-8382-937BBE4968F4@microsoft.com...
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news: 5A8BC289-3DB8-424F-89B2-7024C035186D@microsoft.com...
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news: e0sy1Wm3FHA.3588@TK2MSFTNGP15.phx.gbl...
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news:
C9377270-6214-4FA2-8382-937BBE4968F4@microsoft.com...
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Je suis novice en vba mais je suis m'y mettre a fond. Toutefois, j'ai une
demande ponctuelle :
j'ai un répertoire contenant x fichiers excels dont le contenu est au même
format (un tableau avec le meme nbre de ligne et de colonnes contenant des
motifs). En fait, ce fichier est créé une fois par jour.
Je sais récupérer le n° d'index du motif renseigné dans le tableau.
Toutefois, je dois ouvrir chaque fichier afin d'y récupérer le contenu
(motifs, lignes etc) et de faire un tableau récapitulatif.
Je suis persuadé qu'il y a un moyen de faire cela. Je cherche à droit e et a
gauche, mais je ne trouve que des morceaux de codes.
Quelqu'un peut il m'aider ?
Si ma demande n'est pas claire (chose que je peux comprendre), n'hésitez
surtout pas à me le faire savoir.
Dans tous les cas, je vous remercie d'avance.
Cordialement
PS : une réponse m'a été faite pour la récup des n° index des motifs et je
remercie la ou les personnes qui m'ont aidé.
Bonjour Dudulo,
| "Rg.Offset(1).CopyFromRecordset Rst"
Avec excel 97, la méthode CopyFromRecordSet fonctionne différemment. Comme cette version n'est pas installé sur mon ordi. Je n'ai
pas l'aide associée à ta version de disponible. Tu peux regarder dans l'aide d'excel pour voir comment l'exploiter ... Je te propose
quelque chose qui devrait probablement remplacer cette méthode :
Cette procédure remplace
"Rg.Offset(1).CopyFromRecordset Rst"
Par :
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
De plus, copie la fonction personnalisée dans un module standard.
'--------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
End Sub
'-----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-----------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta réponse.
J'ai testé ton prg, il fonctionne jusqu'a la ligne :
"Rg.Offset(1).CopyFromRecordset Rst"
un message apparait : "cette classe d'objets ne gère pas Automation".
J'ai oublié de te préciser que je suis en excel97.
Bien que je pense (du moins j'essaye) que cela ne vienne du fait qu'il y ai
des cellules fusionnées, j'ai qd meme supprimer la mise en forme, j'ai
remplacer les motifs par leurs num index afin d'avoir un fichier "light".
Merci d'avance a toi et tous ceux qui pourront m'aider.
CordialementBonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Bonjour Dudulo,
| "Rg.Offset(1).CopyFromRecordset Rst"
Avec excel 97, la méthode CopyFromRecordSet fonctionne différemment. Comme cette version n'est pas installé sur mon ordi. Je n'ai
pas l'aide associée à ta version de disponible. Tu peux regarder dans l'aide d'excel pour voir comment l'exploiter ... Je te propose
quelque chose qui devrait probablement remplacer cette méthode :
Cette procédure remplace
"Rg.Offset(1).CopyFromRecordset Rst"
Par :
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
De plus, copie la fonction personnalisée dans un module standard.
'--------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
End Sub
'-----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-----------------------------------
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news: CA4AF246-85DE-46B9-A8FA-B3FE468022DD@microsoft.com...
Bonjour michdenis,
merci pour ta réponse.
J'ai testé ton prg, il fonctionne jusqu'a la ligne :
"Rg.Offset(1).CopyFromRecordset Rst"
un message apparait : "cette classe d'objets ne gère pas Automation".
J'ai oublié de te préciser que je suis en excel97.
Bien que je pense (du moins j'essaye) que cela ne vienne du fait qu'il y ai
des cellules fusionnées, j'ai qd meme supprimer la mise en forme, j'ai
remplacer les motifs par leurs num index afin d'avoir un fichier "light".
Merci d'avance a toi et tous ceux qui pourront m'aider.
Cordialement
Bonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news: 5A8BC289-3DB8-424F-89B2-7024C035186D@microsoft.com...
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news: e0sy1Wm3FHA.3588@TK2MSFTNGP15.phx.gbl...
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news:
C9377270-6214-4FA2-8382-937BBE4968F4@microsoft.com...
Bonjour à tous,
Bonjour Dudulo,
| "Rg.Offset(1).CopyFromRecordset Rst"
Avec excel 97, la méthode CopyFromRecordSet fonctionne différemment. Comme cette version n'est pas installé sur mon ordi. Je n'ai
pas l'aide associée à ta version de disponible. Tu peux regarder dans l'aide d'excel pour voir comment l'exploiter ... Je te propose
quelque chose qui devrait probablement remplacer cette méthode :
Cette procédure remplace
"Rg.Offset(1).CopyFromRecordset Rst"
Par :
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
De plus, copie la fonction personnalisée dans un module standard.
'--------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
End Sub
'-----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-----------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta réponse.
J'ai testé ton prg, il fonctionne jusqu'a la ligne :
"Rg.Offset(1).CopyFromRecordset Rst"
un message apparait : "cette classe d'objets ne gère pas Automation".
J'ai oublié de te préciser que je suis en excel97.
Bien que je pense (du moins j'essaye) que cela ne vienne du fait qu'il y ai
des cellules fusionnées, j'ai qd meme supprimer la mise en forme, j'ai
remplacer les motifs par leurs num index afin d'avoir un fichier "light".
Merci d'avance a toi et tous ceux qui pourront m'aider.
CordialementBonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Bonjour Dudulo,
| "Rg.Offset(1).CopyFromRecordset Rst"
Avec excel 97, la méthode CopyFromRecordSet fonctionne différemment. Comme cette version n'est pas installé sur mon ordi. Je n'ai
pas l'aide associée à ta version de disponible. Tu peux regarder dans l'aide d'excel pour voir comment l'exploiter ... Je te
propose
quelque chose qui devrait probablement remplacer cette méthode :
Cette procédure remplace
"Rg.Offset(1).CopyFromRecordset Rst"
Par :
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
De plus, copie la fonction personnalisée dans un module standard.
'--------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
End Sub
'-----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-----------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta réponse.
J'ai testé ton prg, il fonctionne jusqu'a la ligne :
"Rg.Offset(1).CopyFromRecordset Rst"
un message apparait : "cette classe d'objets ne gère pas Automation".
J'ai oublié de te préciser que je suis en excel97.
Bien que je pense (du moins j'essaye) que cela ne vienne du fait qu'il y ai
des cellules fusionnées, j'ai qd meme supprimer la mise en forme, j'ai
remplacer les motifs par leurs num index afin d'avoir un fichier "light".
Merci d'avance a toi et tous ceux qui pourront m'aider.
CordialementBonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
Bonjour Dudulo,
| "Rg.Offset(1).CopyFromRecordset Rst"
Avec excel 97, la méthode CopyFromRecordSet fonctionne différemment. Comme cette version n'est pas installé sur mon ordi. Je n'ai
pas l'aide associée à ta version de disponible. Tu peux regarder dans l'aide d'excel pour voir comment l'exploiter ... Je te
propose
quelque chose qui devrait probablement remplacer cette méthode :
Cette procédure remplace
"Rg.Offset(1).CopyFromRecordset Rst"
Par :
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
De plus, copie la fonction personnalisée dans un module standard.
'--------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
End Sub
'-----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-----------------------------------
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news: CA4AF246-85DE-46B9-A8FA-B3FE468022DD@microsoft.com...
Bonjour michdenis,
merci pour ta réponse.
J'ai testé ton prg, il fonctionne jusqu'a la ligne :
"Rg.Offset(1).CopyFromRecordset Rst"
un message apparait : "cette classe d'objets ne gère pas Automation".
J'ai oublié de te préciser que je suis en excel97.
Bien que je pense (du moins j'essaye) que cela ne vienne du fait qu'il y ai
des cellules fusionnées, j'ai qd meme supprimer la mise en forme, j'ai
remplacer les motifs par leurs num index afin d'avoir un fichier "light".
Merci d'avance a toi et tous ceux qui pourront m'aider.
Cordialement
Bonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news:
5A8BC289-3DB8-424F-89B2-7024C035186D@microsoft.com...
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:
Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news: e0sy1Wm3FHA.3588@TK2MSFTNGP15.phx.gbl...
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" <dudulo@discussions.microsoft.com> a écrit dans le message de news:
C9377270-6214-4FA2-8382-937BBE4968F4@microsoft.com...
Bonjour à tous,
Bonjour Dudulo,
| "Rg.Offset(1).CopyFromRecordset Rst"
Avec excel 97, la méthode CopyFromRecordSet fonctionne différemment. Comme cette version n'est pas installé sur mon ordi. Je n'ai
pas l'aide associée à ta version de disponible. Tu peux regarder dans l'aide d'excel pour voir comment l'exploiter ... Je te
propose
quelque chose qui devrait probablement remplacer cette méthode :
Cette procédure remplace
"Rg.Offset(1).CopyFromRecordset Rst"
Par :
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
De plus, copie la fonction personnalisée dans un module standard.
'--------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.Offset(1).Resize(nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
End Sub
'-----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-----------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta réponse.
J'ai testé ton prg, il fonctionne jusqu'a la ligne :
"Rg.Offset(1).CopyFromRecordset Rst"
un message apparait : "cette classe d'objets ne gère pas Automation".
J'ai oublié de te préciser que je suis en excel97.
Bien que je pense (du moins j'essaye) que cela ne vienne du fait qu'il y ai
des cellules fusionnées, j'ai qd meme supprimer la mise en forme, j'ai
remplacer les motifs par leurs num index afin d'avoir un fichier "light".
Merci d'avance a toi et tous ceux qui pourront m'aider.
CordialementBonjour Dudulo,
Tu ouvres VBE : Raccourci clavier Atl + F11
Barre des menus / outils / référence / et dans la liste
tu coches la référence mentionnée.
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour
Merci pour tout, je vais le tester.
Toutefois, tu me dis de charger la bibliothèque Microsoft Activex Data
Objects 2.0 Librairy, mais je la trouve où ?
Je suis désolé de te poser cette question mais suis novice en la matière.
Dans tous les cas, merci encore etje ne manquerais pas de revenir vers toi
pour te tenir au courant.
Cordialement
"michdenis" wrote:Bonjour Dudulo,
L'Ouverture de la connection vers chacun des fichiers étaient
situés au mauvais endroit dans la procédure ! Désolé.
Pas tester.. seulement adapter ...
'-----------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'Crée l'objet connection ...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
'établir une connection avec chacun des fichiers
' à tour de rôle...
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------
Salutations!
"michdenis" a écrit dans le message de news:
Bonjour Dudulo,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
'-----------------------------------------------
Sub MaRequêteAvecADO()
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String
NomFeuille = "denis" 'A déterminer
Chemin = "C:Data" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil1")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).CopyFromRecordset Rst
Else
Rg.CopyFromRecordset Rst
End If
File = Dir()
Rst.Close
Loop
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'-----------------------------------------------
Salutations!
"dudulo" a écrit dans le message de news:
Bonjour à tous,
