importer lot de fichier text

Question

Bonjour à tous, Je fais appel à vous pour un problème qui me bloque depuis deux jours. Je vous explique : j'ai un lot de n fichiers texte qui se trouvent dans un répertoire. Je veux les ouvrir dans excel, faire dessus quelques manipulations (pour ça je me débrouille) puis les refermer. J'ai bricolé le code suivant. Le problème c'est que je n'arrive qu'à ouvrir qu'un fichier à la fois (et j'ai 385 fichiers à modifier...). il me manque en fait une variable qui dirait "ouvre chaque fichier du répertoire" au lieu de ouvre tel fichier. 'macro pour importer dans excel des fichiers text et enregistrer le fichier xls dans le même repertoire Sub OuvrirfichierTxt() Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject") Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture d'Excel StrPath = "M:\ETUDES EN COURS\2006\06E023 Fédération Collectivités de l'eau SDA SeineMaritime\Donnees technique est excel" 'Chemin d'accès du fichier If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute \ à la fin s'il y en a pas StrFich = "AMBRUMESNIL-20-10-05" 'Nom du fichier If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier waExcel.Visible = False 'Rendre invisible Excel 'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space waExcel.Workbooks.OpenText StrPath & StrFich, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _ :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _ False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1) _ , TrailingMinusNumbers:=True 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich, Len(StrFich) - 4) & ".xls", , , , , , 2 End If 'Fermeture d'Excel waExcel.Application.Quit End Sub J'ai mis en rouge le nom du fichier que j'ai utilisé pour tester mon code. Il m'a bien créer un fichier xls dans le même répertoire mais je voudrais que la manip boucle sur chaque fichier de mon répertoire. J'espère avoir été assez clair dans mes explications. Merci d'avance pour votre aide. Trollakuir

jrivet · Answer

Salut, Utilise la fonction Dir avec une boucle. Ce qui donnerai a peu pres (je n'est pas testé) Sub OuvrirfichierTxt() Dim waExcel: Set waExcel = CreateObject ("Excel.Application") 'Ouverture d'Excel StrPath = "M:\ETUDES EN COURS\2006\06E023 Fédération Collectivités de l'eau SDA SeineMaritime\Donnees technique est excel" 'Chemin d'accès du fichier If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute \ à la fin s'il y en a pas StrFich = Dir (StrPath, vbArchive) Do While MyName <> "" ' Commence la boucle. waExcel.Visible = False 'Rendre invisible Excel 'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space waExcel.Workbooks.OpenText StrPath & StrFich, Origin:= xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _ :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _ False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1) _ , TrailingMinusNumbers:=True 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs waExcel.Workbooks(StrFich).SaveAs StrPath & Left (StrFich, Len(StrFich) - 4) & ".xls", , , , , , 2 StrFich = Dir ' Extrait l'entrée suivante. Loop 'Fermeture d'Excel waExcel.Application.Quit End Sub Coloration syntaxique automatique [AFCK] @+, Julien Pensez: Moteur de Recherche, Réponse Acceptée Mais Surtout: Règlement/FONT>

cs_JMO · Answer

Bonjour ,

Une simple boucle suffit.

Do While...Loop (exemple de Julien)
ou
For Each....Next (exemple ci-dessous)

Dim Path
Path  = "d:	est1" 
MsgBox ShowFolderList(Path),vbmessage,"Fichiers présents dans le  répertoire"
Function ShowFolderList(strPath) 
Dim fso, Dossiers, fic, fichiers, strListe, f, fdate, fname, dtDiffFile, nbre_fichier 
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(path)
Set fic = Dossiers.Files


For Each fichiers in fic 
    Set f = fso.GetFile(fichiers)
    fdate = f.DateLastModified  ' ou DateCreated
    fname = f.Name
    dtDiffFile = DateDiff("d", Now, fdate)
    If dtDiffFile <= -5 Then 
       MsgBox  "Le fichier " & Path & fname & " sera supprimé car créé le " & fdate
'''''  fso.DeleteFile(Path & fname)
       nbre_fichier = nbre_fichier + 1
    Else 
       MsgBox "Le fichier " & Path & fname & " ne sera pas supprimé car créé le " & fdate
   End If
   strListe = strListe & vbcrlf & vbcrlf & fname & " " & fdate 
Next
ShowFolderList = "Nombre de fichiers: " nbre_fichier &vbCrLf& strListe 
End Function

jean-marc

jrivet · Answer

Re,

Pendant que j'y pense, il y a un test que je ne fais pas dans ma boucle c'est si le Dir te renvoie bien un fichier a importer.

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
Mais Surtout: Règlement/FONT>

Importer lot de fichier text

3 réponses

Votre réponse

Discussions similaires