James68100
Messages postés2Date d'inscriptionlundi 8 mars 2010StatutMembreDernière intervention11 mars 2010
-
9 mars 2010 à 10:23
James68100
Messages postés2Date d'inscriptionlundi 8 mars 2010StatutMembreDernière intervention11 mars 2010
-
11 mars 2010 à 12:46
Bonjour,
Je cherche à compléter ma macro qui devrait :
1. Rechercher tout les fichiers .csv d'un répertoire
2. Recopier la liste de ces fichiers(en lien hypertexte) sur la première feuille d'un classeur Excel (main.xlsm)
3. D'ouvrir chacun des liens hypertextes, de copier le contenu du fichier .csv
4. Pour finir sur un autre onglet de main.xlsm, coller le nom du csv sur la colonne A (plusieurs fois) et le contenu correspondant sur les autres colonne.
Ex : A B
F1.CSV donnée A
F1.CSV donnée B
F1.CSV donnée C
F2.CSV donnée A
F2.CSV donnée B
___________________________________________
J'ai réussit deja le 1 et 2 voila mon code
Dim Tblo()
Dim A As Long
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String
A = 0
Répertoire = "U:"
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If
End Sub
Sub FoldersInFolder(myFolderName As String)
Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object
Set FSO = CreateObject("scripting.filesystemobject")
Set myBaseFolder = FSO.getfolder(myFolderName)
For Each myFolder In myBaseFolder.SubFolders
Call Contenu_Répertoire(myFolder.Path & "")
Call FoldersInFolder(myFolder.Path)
Next myFolder
End Sub
Sub Contenu_Répertoire(Chemin As String)
Dim Fichier As String
Fichier = Dir(Chemin & "\*.csv")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
Sub Traitement()
Dim Tablo1
For i = 1 To UBound(Tblo)
Tablo1 = Split(Tblo(i), "")
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=Tblo(i), TextToDisplay:=Tablo1(UBound(Tablo1))
Range("A1").Select 'je n'arrive pas à ouvrir le lien hypertexte
lien = Selection.Hyperlinks(1).SubAddress
Next i
End Sub
Si quelqu'un a une idée ou une piste, merci d'avance