Liste des fichiers CSV dans une feuille

Version imprimable

11/02/2009, 02h45
DubDub

Liste des fichiers CSV dans une feuille

Alors, voici ce que j'aimerais faire

sms me retourne un inventaire de logiciel pour un poste donné

le fichier retourné par sms est sous forme NomPoste.csv

dans le classeur excel feuil1 je liste les nom de postes

P100236
P100237
P100265

quand je clique sur un bouton la macro excel récupere dans un repertoire precis les fichiers.csv qui sont liste dans la feuil P100236,P100237

merci a l'avance de votre aide
11/02/2009, 08h01
PPz78

Pour récupérer les noms des fichiers contenus dans un répertoire il faut utiliser la fonction

Code:

Nom_fichier= Dir (....)

.
Pour les détails il te faut aller sur l'aide en ligne.
Tu peux même préciser à cette fonction que tu n'est intéressé que par les fichiers de type .csv

comment renomer la sheet avec le nom du fichier .csv

je cherche toujours

j'arrive a ouvrir un fichier avec le code suivant

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub OuvrirFichier()
 
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\RapportsSMS\sog6300.csv", Destination:=Range("A1"))
        .Name = "sog6300"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("B:C").Select
    Selection.ClearContents
    Rows("1:1").Select
    Selection.ClearContents
    Selection.Delete Shift:=xlUp
    Range("A1").Select
End Sub

mais j'aimerais qu'il ouvre TOUT les fichier.csv dans le repertoire en renommant le nom de la feuille avec le nom du fichier .csv

c'est fou le temps qu'on perd a cherché, faut passer par la pour apprendre..

Merci a l'avance

12/02/2009, 11h22
ouskel'n'or

Le code pour lister les fichiers d'un répertoire, c'est comme le nom des fous, il est écrit partout. Une recherche sur le forum te le donnera en x exemplaires, que ce soit avec dir ou filesearch.
Il te restera à ouvrir le csv. Le code différant selon la version, tu as ça ici.
Tiens, pendant que j'y étais, pour lister les fichiers d'un répertoire.
Tu remplaces cette ligne

Citation:

If NomFich = "" Or Right(NomFich, 4) <> ".xls" Then

par

Code:

If NomFich = "" Or Right(NomFich, 4) <> ".csv" Then

et tu remplaces le code d'ouverture par celui correspondant pour les csv, trouvé ici.
Bonne prog'

trop simple pour toi

je fais vraiment des efforts mais .... suite a tes indications j'arrive avec un trucs comme sa

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Ouvrir(Chemin As String, FL1 As Workbook)
Dim NomFich As String
    NomFich = Dir(Chemin & "\")
    If NomFich = "" Or Right(NomFich, 4) <> ".csv" Then
         MsgBox "Aucun fichier trouvé dans " & Chemin & "."
         Exit Sub
    End If
    Do While NomFich <> ""
        Application.EnableEvents = False
            Workbooks.Open Chemin & "\" & NomFich
            DoEvents
        Application.EnableEvents = True
        NomFich = ActiveWorkbook.Name
        Copie NomFich, FL1
        NomFich = Dir
    Loop
End Sub
 
 
Sub Appel()
Dim FL1 As Workbook, Chemin As String
    Application.ScreenUpdating = False
        Chemin = "C:\Users\Eric\Desktop\test"
        Set FL1 = ThisWorkbook
        Ouvrir Chemin, FL1
    Application.ScreenUpdating = True
    MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub

evidament sa marche pas :-( et je ne comprend pas pourquoi je doit faire deux sub (ouvrir et Appel) je ne peux pas tout mettre dans le meme ?

Meric

Effectivement, ton code de copie ne veut rien dire. Je t'avais également donné l'url du code d'ouverture du fichier à utiliser selon les cas.
Si ton fichier a des points-virgules pour séparateurs de données, tu dois l'ouvrir en tant que fichier texte (Excel 2003)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Ouvrir(Chemin As String, FL1 As Workbook)
Dim NomFich As String
    NomFich = Dir(Chemin & "\")
    If NomFich = "" Or Right(NomFich, 4) <> ".csv" Then
         MsgBox "Aucun fichier trouvé dans " & Chemin & "."
         Exit Sub
    End If
    Do While NomFich <> ""
        'on reécupère le nom de la feuille sans l'extension
        NomFeuil = Left(NomFich, Len(NomFich) - 4)
        'on renomme le fichier en txt afin de pouvoir l'ouvrir
        NewName = Chemin & "\" & NomFeuil & ".txt"
        Name Chemin & "\" & NomFich As NewName
 
        '************ Code d'ouverture des fichiers ************
        Workbooks.OpenText Filename:=NewName, StartRow:=1, _
        DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter _
            :=False, Semicolon:=True
        DoEvents 'laisse au système le temps d'ouvrir le fichier si important
        '***********************************************
 
        '****** ici, on ne copie pas le classeur mais la feuille *******
        ActiveSheet.Copy After:=FL1.Sheets(FL1.Sheets.count)
 
        'feuille que l'on renomme du nom du classeur moins l'extension
        ActiveSheet.Name = NomFeuil
 
        'et on va chercher le classeur suivant
        NomFich = Dir
    Loop
End Sub

Ce code ouvre un csv ayant des ";" (points-virgules) pour séparateurs de données.
Si les séparateurs sont des tabulations ou des virgules, l'url que j'ai mise en parle aussi !

13/02/2009, 15h37
DubDub

Merci mais.....

c'est vraiment gentil de me donner un coup de pouce par-contre, comme je mentionne je suis trop nouveau pour bien utiliser ce que tu me donne

de plus je n'ai pas vraiment de reponse a mes questions:

qui sont sont:

si je fais un copier coller de ton code dans la macro et aue je clique exécuter, évidament il m'ouvre un fenetre en me demandant le nom de la macro....

j'en connais juste asser pour savoir que je dois appeler ce code via une autre ligne, mais comment..... le url que tu me donne ou effectivement un fichier .csv mais ne correcpond pas au parametre attendu par le code que tu m'a fournie....

crois je passe beaucoup de temps a essayer de comprend mais quand tu part de rien... la route est longue...

Merci encore de ton coup de pouce
13/02/2009, 18h34
ouskel'n'or
Je t'ai donnée plusieurs url, dont une dans laquelle tu as la syntaxe pour appeler la macro ci-dessus. Que veux-tu ? que je le remette ici ?
Pour appeler la macro Ouvrir, que te faut-il ?

Citation:

Sub Ouvrir(Chemin As String, FL1 As Workbook)

Chemin ? C'est le chemin des fichiers csv sans "\"
FL1 As Workbook ?
Dans la sub Appel() tu as l'instanciation du classeur devant recevoir les copies de csv
Code:

1 2 3 4 5 Sub Appel() Dim FL1 As Workbook, Chemin As String Application.ScreenUpdating = False Chemin = "D:\xls" Set FL1 = ThisWorkbook
Tu as donc tous les éléments en main, il te suffit de lire.
Si tu as encore des problèmes, alors lis les tutoriels ou renonce à VBA.
14/02/2009, 00h51
DubDub

quoi dire... A l'aide....

:(:(

merci de ta patience j'apprecie vraiment, meme si on se comprend pas trop,

le but du forum c'est justement de rendre ce qui est evident pour vous plus facile pour nous

j'ai essayer de mettre mon chemin c:\RapportsSMS

merci
14/02/2009, 09h50
ouskel'n'or

Si c:\RapportsSMS est le répertoire contenant les csv, ça devrait fonctionner.
As-tu toujours un problème ? Lequel ? Une erreur ? Quelle erreur ? (Indique la ligne et le message d'erreur)
Et le mieux serait que tu mettes le code complet : Appel de la procédure d'ouverture et de copie ainsi que la procédure d'ouverture et de copie elle-même.

j'ai hate de comprendre mon erreur...

Merci ouskel

quand je suis dans VB le code est placer dans la feuille ThisWorkbook, j'ai reverifier les chemins tout seul ok. quand je clique sur le petit bouton "play"
rien ne se passe, si je fait le mode suivre pas a pas la ligne jaune se position sur Sub Appel(), puis au prochain "step" plus rien. voici le code en entier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Dim NomFich As String
    NomFich = Dir(Chemin & "\")
    If NomFich = "" Or Right(NomFich, 4) <> ".csv" Then
         MsgBox "Aucun fichier trouvé dans " & Chemin & "."
         Exit Sub
    End If
    Do While NomFich <> ""
        'on reécupère le nom de la feuille sans l'extension
        NomFeuil = Left(NomFich, Len(NomFich) - 4)
        'on renomme le fichier en txt afin de pouvoir l'ouvrir
        NewName = Chemin & "\" & NomFeuil & ".txt"
        Name Chemin & "\" & NomFich As NewName
 
        '************ Code d'ouverture des fichiers ************
        Workbooks.OpenText Filename:=NewName, StartRow:=1, _
        DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter _
            :=False, Semicolon:=True
        DoEvents 'laisse au système le temps d'ouvrir le fichier si important
        '***********************************************
 
        '****** ici, on ne copie pas le classeur mais la feuille *******
        ActiveSheet.Copy After:=FL1.Sheets(FL1.Sheets.Count)
 
        'feuille que l'on renomme du nom du classeur moins l'extension
        ActiveSheet.Name = NomFeuil
 
        'et on va chercher le classeur suivant
        NomFich = Dir
    Loop
End Sub
--------------------------------------------------------------------------
Sub Appel()
Dim FL1 As Workbook, Chemin As String
    Application.ScreenUpdating = False
        Chemin = "C:\Users\Eric\Desktop\Job\test"
        Set FL1 = ThisWorkbook
End Sub

tout sa est dans la meme page je ne sais pas si je doit mettre le sub Appel ailleur...

encore merci pour ta patience... :roll:

15/02/2009, 18h19
Dinytro

Et si tu nous donnais ton fichier ?

Trois remarques :
Place la procédure Ouvrir dans un module standard
Il manque une ligne à ta procédure Appel. Si tu avais regardé l'url que je t'ai passée, tu l'aurais vu.
(***) Si tu n'appelles pas la procédure... la procédure elle marche pas :aie:
Enfin, si tu souhaites que la procédure s'exécute à l'ouverture du fichier, (ce que tu sembles souhaiter puisque tu la places dans Thisworkbook) ce n'est plus Appel que tu dois la nommer mais Private Sub Workbook_Open()
Code:

1 2 3 4 5 6 7 Private Sub Workbook_Open() Dim FL1 As Workbook, Chemin As String Application.ScreenUpdating = False Chemin = "C:\Users\Eric\Desktop\Job\test" Set FL1 = ThisWorkbook Ouvrir Chemin, FL1 '(***) End Sub
Et essai de comprendre ce que tu fais.
Bonne soirée

apres une petite pause

Bonjour,

le code ouvre bien mes 2 fichiers.csv mais dans des classeurs différents
+ 2 feuilles blanches dans mon classeur de depart avec le nom de mes fichiers

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Ouvrir(Chemin As String, FL1 As Workbook)
Dim NomFich As String
    NomFich = Dir(Chemin & "\")
    If NomFich = "" Or Right(NomFich, 4) <> ".csv" Then
         MsgBox "Aucun fichier trouvé dans " & Chemin & "."
         Exit Sub
    End If
    Do While NomFich <> ""
        'on récupère le nom de la feuille sans l'extension
        NomFeuil = Left(NomFich, Len(NomFich) - 4)
        'on renomme le fichier en txt afin de pouvoir l'ouvrir
        NewName = Chemin & "\" & NomFeuil & ".txt"
        Name Chemin & "\" & NomFich As NewName
 
        '************ Code d'ouverture des fichiers ************
        Workbooks.OpenText Filename:=NewName, StartRow:=1, _
        DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter _
            :=False, Semicolon:=True
        DoEvents 'laisse au système le temps d'ouvrir le fichier si important
        '***********************************************
 
        '****** ici, on ne copie pas le classeur mais la feuille *******
        ActiveSheet.Copy After:=FL1.Sheets(FL1.Sheets.Count)
 
        'feuille que l'on renomme du nom du classeur moins l'extension
        ActiveSheet.Name = NomFeuil
 
        'et on va chercher le classeur suivant
        NomFich = Dir
    Loop
End Sub
-----------------------------------------------------------------------
Sub Appel()
Dim FL1 As Workbook, Chemin As String
    Application.ScreenUpdating = False
        Chemin = "C:\Users\Eric\Desktop\Job\test"
        Set FL1 = ThisWorkbook
        Ouvrir Chemin, FL1
End Sub

merci de votre aide et de votre patience.

19/02/2009, 08h05
PPz78

Il ne reste plus qu'à les recopier à l'endroit souhaité.
Cela ne devrait pas être trop difficile.