[VBA-E] Parcourir un repertoir et opérations sur fichiers xls

Version imprimable

06/03/2007, 20h24
anisr

[VBA-E] Parcourir un repertoir et opérations sur fichiers xls

Bonjour,

Comment faire pour parcourir tous les fichiers xls situés dans un répertoir et d'inserer pour chaque fichier une nouvelle feuille avant d'enregistrer et de quitter?

Merci de votre aide.

bonsoir

Cela ne répondra sans doute pas exactement à ta demande, mais juste pour le fun, une possibilité pour ajouter un onglet dans tous les classeurs d'un répertoire, sans les ouvrir:

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
Sub AjoutFeuilles_Dans_ClasseursFermes()
    Dim ExcelCn As Object
    Dim maFeuille As String, Repertoire As String
    Dim NomClasseur As String
 
    'Dossier contenant les classeurs Excel
    Repertoire = "C:\DossierTest"
    'Nom de la nouvelle feuille Excel
    maFeuille = "MaNouvelleFeuille"
 
    NomClasseur = Dir(Repertoire & "\*.xls")
 
    'Boucle sur les classeurs
    Do While NomClasseur <> ""
        'Connection au classeur Excel
        Set ExcelCn = CreateObject("ADODB.Connection")
        ExcelCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                       "Data Source=" & Repertoire & "\" & NomClasseur & ";" & _
                       "Extended Properties=""Excel 8.0;HDR=NO;"""
 
        'Création nouvelle Feuille
        ExcelCn.Execute "create table " & maFeuille & "(Essai Memo)"
 
        ExcelCn.Close
        Set ExcelCn = Nothing
NomClasseur = Dir
Loop
 
MsgBox "Terminé"
End Sub

michel

Bonsoir

Peut-être peux-tu t'inspirer de ce qui suit

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
Sub AjoutFeuillesFichiersDossier()
    Dim fs As New Scripting.FileSystemObject
    Dim Dossier As Scripting.Folder
    Dim Fichier As Scripting.File
    Dim Fichiers As Scripting.Files
    Dim NomDossier As String
    Dim Classeur As Workbook
    Dim Feuille As Worksheet
 
    NomDossier = "c:\données\ajoutfeuilles"
 
    Set Dossier = fs.GetFolder(NomDossier)
    Set Fichiers = Dossier.Files
 
    For Each Fichier In Fichiers
        If Fichier.Type = "Feuille de calcul Microsoft Excel" Then
            Set Classeur = Workbooks.Open(Fichier.Path)
            Set Feuille = Classeur.Worksheets.Add()
            Feuille.Name = "Feuille ajoutée"
            Classeur.Save
            Classeur.Close
        End If
    Next Fichier
 
End Sub

Ok?

06/03/2007, 21h18
Pierre Fauconnier

Citation:

Envoyé par SilkyRoad

bonsoir

Cela ne répondra sans doute pas exactement à ta demande, mais juste pour le fun, une possibilité pour ajouter un onglet dans tous les classeurs d'un répertoire, sans les ouvrir:

JOLI :king:
06/03/2007, 21h22
SilkyRoad

bonsoir cher Pierre ... ;o)
07/03/2007, 01h29
ouskel'n'or

Citation:

Envoyé par SilkyRoad

bonsoir
Cela ne répondra sans doute pas exactement à ta demande, mais juste pour le fun, une possibilité pour ajouter un onglet dans tous les classeurs d'un répertoire, sans les ouvrir:
michel

! :king: +1
07/03/2007, 05h43
anisr

Bonjour,

et si les fichiers sont des fichiers txt comment faire pour obtenir le même résultat?

A+
07/03/2007, 06h01
SilkyRoad

bonjour

Citation:

et si les fichiers sont des fichiers txt comment faire pour obtenir le même résultat?

???
Tu peux préciser ta demande?

michel
07/03/2007, 07h42
anisr

En fait mes fichiers sont enregistrés en txt que je souhaite transformer en xls puis ajouter dans chaque fichiers xls une feuille.

En outre, quand j'execute le code de Pierre j'ai une erreur sur l'instruction

Code:

Scripting.FileSystemObject

Il parait que c'est un objet absent que faire?
07/03/2007, 08h05
SfJ5Rpw8

Citation:

Envoyé par anisr

... j'execute le code de Pierre j'ai une erreur sur l'instruction

Code:

Scripting.FileSystemObject

Il parait que c'est un objet absent que faire?

il te manque la référence à "Microsoft Scripting runtime"..;) (menu outils/références ....)
07/03/2007, 08h32
anisr

tu as raison en rajoutant cette réference le code ne génére plus d'erreur:king: . Toutefois, il parait que le fait de copier les fichiers txt avec le même nom .xls ne résoud pas le problème. :?
Donc comment faire pour enregistrer ces fichiers txt sous format xls?:oops:

Merci de votre aide.
07/03/2007, 19h39
SilkyRoad

Citation:

Donc comment faire pour enregistrer ces fichiers txt sous format xls?

Ouvre tes fichiers .txt dans Excel (consulte la méthode OpenText)
puis enregiste le classeur (méthode SaveAs)

michel

J'ai essayé ce code mais je ne comprend pas pourquoi ça ne marche pas

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub transormation()
 
Fichier = Dir("C:\txt\Extraction\txt\")
 
Workbooks.OpenText Filename:=Fichier, _
    DataType:=xlDelimited, Tab:=True
 
ActiveWorkbook.SaveAs Filename:=Fichier, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
 
End Sub

08/03/2007, 11h41
AlainTech

Citation:

Envoyé par anisr

je ne comprend pas pourquoi ça ne marche pas

Nous non plus.
Si tu ne nous dis pas ce qui ne va pas ou quel est le message d'erreur, on peut difficilement deviner.
08/03/2007, 12h31
anisr

Le message d'erreur est

Citation:

Errer d'execution 1004 erreur definie par l'appliction ou l'objet

Merci de votre aide.
08/03/2007, 13h45
ouskel'n'or

Citation:

Sub transormation()
Fichier = Dir("C:\txt\Extraction\txt\")

Si tu fais ça, les premiers noms de fichiers seront "." et "..", des noms de répertoires qui bien sûr ne sont pas accessibles.
Tu dois donc avant d'essayer d'ouvrir tes fichiers, vérifier que ce sont bien des fichiers et non des répertoires.
Tu as dans l'aide, à Dir, tout ce qu'il te faut pour faire ça ;)
08/03/2007, 14h53
anisr

Désolé j'ai vu l'aide Dir, mais je n'est rien pigé.

bonjour

Code:

1
2
3
4
5
6
Dim Fichier As String
 
Fichier = "C:\txt\Extraction\txt\NomFichier.txt"
 
Workbooks.OpenText Filename:=Fichier, _
            DataType:=xlDelimited, Tab:=True

michel