Ouverture automatique de fichiers textes

[krysprolz]

Bonjour à tous,
J'ai écumé pas mal de forum et de post mais je ne trouve pas de solutions à mon problème. Je dispose d'un dossier dans un emplacement variable et contenant X fichiers de type texte (ex du nom des fichiers : 2011-07-29_05h49mn45). Je dois transformer ces fichiers texte en fichiers excel afin de les mettre en forme. Le but de la macro serait :
1) demander un chemin contenant le dossier ou se trouvent les fichiers
2) selectionner automatiquement le premier fichier du dossier (tri par horodatage)
3) l'ouvrir/le convertir/mettre en forme/enregistrer en .xls
4) passer au fichier suivant du dossier
5) recommencer au 1) jusqu'à ce que tous les fichiers du dossiers soient traités.

Pour le 1) j'ai trouvé pour le moment :

Sub Choix_dossier()
Dim Dossier As String
Application.FileDialog(msoFileDialogFolderPicker).Show
Dossier = Application.FileDialog(msoFileDialogFolderPicker).InitialFileName

Pour le 2) et le 4) je ne sais pas comment faire, pas de soucis par contre pour le 3).
Je suis novice en matière de vba et je me debrouille en général en recopiant des bouts de codes à droite et à gauche, mais la je sèche !
Quelqu'un pourrait-il m'aider ?
Un grand merci pour toutes les réponses que vous pourrez m'apporter.

 

[kjin]

Re : Ouverture automatique de fichiers textes

Bonjour,
Pourtant c'est un sujet récurant du forum...
Néanmoins, sans fichiers exemples, difficile de répondre plus précisément
A+
kjin

 

[krysprolz]

Re : Ouverture automatique de fichiers textes

J'ai effectivement trouvé sur le forum un fichier pour ouvrir les fichiers textes d'un dossier et les copier dans des onglets d'un fichier excel. La macro trouvée est :
___________________________________________________
Sub TransfertTxtVersExcel()
Dim Trouve As Byte, X As Byte

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Application.FileSearch
.NewSearch
.Filename = ".txt"
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending

If .Execute > 0 Then
With .FoundFiles
For X = 1 To .Count
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Worksheets(Sheets.Count)
Workbooks.Open ThisWorkbook.Path & " \" & Dir(.Item(X))
ActiveWorkbook.Sheets(1).UsedRange.Copy
ThisWorkbook.Sheets(X + 1).Range("A1").PasteSpecial
'option pour que chaque onglet recupere le nom du fichier Txt : à adapter selon projet
ThisWorkbook.Worksheets(X + 1).Name = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
ActiveWorkbook.Close

Next X
End With
End If
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
ThisWorkbook.Sheets("feuil1").Activate
End Sub
_______________________________________________

Cela ne fonctionne pas dans mon cas, il me met comme erreur qu'il ne trouve pas le fichier xxxx.txt. Cela serait pourtant parfait pour mon application. Est-ce un pb lié au type de fichier que je cherche à convertir ?
J'ai mis un de mes fichiers texte en PJ.

 

[kjin]

Re : Ouverture automatique de fichiers textes

Bonjour,
Merci de mettre les codes entre balises (# dans le menu)
En l'état, la recherche se fait dans le répertoire du fichier actif
Tu n'indiques aucunement ta version d'excel, mais note que FileSearch ne fonctionne qu'avec des versions antérieures à 2007, donc il vaudrait mieux utiliser le FSO
Il existe plusieurs solutions, néanmoins, en gardant le principe (non testé)...

Sub TransfertTxtVersExcel()
Dim Dossier$, x As Byte
Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet

Set wb1 = ThisWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count > 0 Then
        Dossier = .SelectedItems(1)
    End If
End With
If Dossier = "" Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Application.FileSearch
    .NewSearch
    .Filename = "*.txt"
    .LookIn = Dossier
    .SearchSubFolders = False
    .Execute msoSortByFileName, msoSortOrderAscending
    If .Execute > 0 Then
        With .FoundFiles
            For x = 1 To .Count
                wb1.Sheets.Add after:=wb1.Worksheets(Sheets.Count)
                Set ws1 = ActiveSheet
                Workbooks.Open Dossier & "\" & Dir(.Item(x))
                Set wb2 = ActiveWorkbook
                With wb2
                    .Sheets(1).UsedRange.Copy ws1.Range("A1")
                    ws1.Name = Left(.Name, Len(.Name) - 4)
                    .Close False
                End With
            Next x
        End With
    End If
End With
ThisWorkbook.Sheets("feuil1").Activate

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

...devrait fonctionner
A+
kjin