Sujet Précédent Sujet Suivant

Récupération de données de plusieurs classeurs

willypeters Messages postés 1 Date d'inscription vendredi 7 août 2009 Statut Membre Dernière intervention 7 août 2009 - 7 août 2009 à 15:16
 bretsainclair - 24 avril 2013 à 09:55
Bonjour,

Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, coupe, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs
J'ai récupéré le code de MichDenis qui fonctionne très bien mais j'aimerai qu'au lieu de copier les données de chaques fichiers il coupe et vide chaque fichier.

Merci par avance ;)

Voici le code
'--------------------------------------
Sub Test()

'Ne pas oublier le "" à la fin du nom du répertoire
'"c:\AAA" -> répertoire à scanner
Extraire_Data_First_Excel_Sheet "c:\AAA"

End Sub

'--------------------------------------
Sub Extraire_Data_First_Excel_Sheet(Chemin As String)

'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"

'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"

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 ModeCalcul As String

'Extrait le premier fichier du répertoire
file = Dir(Chemin & "\*.xls")

ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Do While file <> ""
'Nom de la feuille où les données seront copiées
'dans le classeur où la macro est écrite :
'Détermine la première cellule où seront copiées
'les données des requêtes des classeurs
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 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;"""

'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)

'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"

'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic

'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Passe au classeur suivant
file = Dir()
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Loop
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst Nothing: Set Conn Nothing
Set Rg = Nothing
End Sub
'--------------------------------------
Function FirstExcelSheetName(Fichier As String)
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'--------------------------------------

2 réponses

Réponse 1 / 2
mab2010 Messages postés 7 Date d'inscription jeudi 1 avril 2010 Statut Membre Dernière intervention 20 juillet 2010
20 juil. 2010 à 12:17
slt willypeters,
j'ai presque le même problème mais moi il sagie de 2 fichiers qui contiennent chacun un tableau de structures différente(et qui peuvent changer) , il faut copier toutes les colonnes du tableau1 et coller dans un ème fichier(maBase par exemple) puis toutes les colonnes du tableau2 sauf les 3 premières colonnes qui sont identiques aux 3 premieres colonnes du tableau1 et coller tabeau2 à la fin du tableau1 pour que ça soit un seul tableau dans maBase.
Nb les 3 fichiers sont dans le même répertoire .
Si toi ou un autre as a une idée je veux que vous m'aidez.
J'attend votre réponse c'est urgent!
Merci .
0
Réponse 2 / 2
bretsainclair
24 avril 2013 à 09:55
Bonjour,
J'ai utilisé ce code presque à l'identique car il correspond tout à fait à mes besoins.
Je stocke des fichiers excel et cette macro me permet de les fusionner en un seul.
Mais maintenant, je remplace mon espace de stockage par un espace sharepoint.
Le chemin pour trouver les fichiers n'est donc plus de la forme "c:\AAA", mais une url de type "http://shp.itn.nom/sites/zzext/"
En changeant le chemin par l'url, ça ne fonctionne pas. Evidemment, la fonction dir est inadaptée aussi...
Bref, je n'arrive pas à adapter cette macro dans le cas où les fichiers sont stockés sur le "cloud" (accessible par une url) au lieu d'un répertoire sur le disque.
Avez-vous une solution à me proposer?
0

Discussions similaires

recuperation de données d'un serveur distant dans android
jasminejas -
BunoCS -

6 réponses
extraction de données d'une base oracle
amrouche015 -
nhervagault -

5 réponses
Chargement de données
telecomakram -
Neo_Fr -

2 réponses
Erreur de conversion du type de données varchar en numeric.
cs_houba80 -
SharpMao -

3 réponses
Prob de Restauration base de données
cindyb -
Orange -

3 réponses
Rejoignez-nous