chris6999
XLDnaute Impliqué
POST ANNULE car j'ai compris quel était le problème
Bonsoir,
J'ai créé avec l'aide du FORUM une macro qui va récupérer les données contenues dans un répertoire dont le nom est défini en fonction d'une date.
Le chemin d'accès au répertoire est renseigné dans la cellule F9 de mon fichier.
Le fichier rechercher au format .txt commence par TI43.T00 (des fois en majuscule, des fois en minuscule).
Ce que je souhaite faire c'est demander au système de rechercher le répertoire en question.
Si celui-ci est introuvable : message d'alerte et sortie de la macro
Si celui-ci est trouvé mais que le fichier .txt est introuvable : message d'alerte et sortie de la macro
Si le fichier est trouvé l'ouvrir, copier l'intégralité du contenu et copier ce contenu dans la cellule C1 de la feuille "mise en forme".
L'idéal serait de fermer le fichier .txt qui ne sert plus à rien.
La macro que j'avais adaptée et qui fonctionnait à peu près ne marche plus....Je l'ai tellement modifiée que je ne sais plus où j'en suis.
Je mets en PJ un fichier test et un répertoire.
Si quelqu'un peut m'aider..
Merci d'avance
Cordialement
Ma macro actuelle est la suivante:
Sub RécupérerFichier()
Application.ScreenUpdating = True
MsgBox "Traitement des données en cours. Merci de patienter quelques instantes"
Application.ScreenUpdating = False
Dim ChercheFichier As FileSearch
Dim Chemin As String
Dim I As Integer
Dim debut
Dim ouvr
Chemin = ThisWorkbook.Sheets("MENU").Range("F9").Value
Set ChercheFichier = Application.FileSearch
Chemin = ThisWorkbook.Sheets("MENU").Range("F9").Value
With ChercheFichier
.NewSearch
.Filename = "*.txt"
.LookIn = Chemin
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
debut = Left(Dir(.Item(I)), 8)
If debut = "TI43.T00" Then
' a adapter selon emplacement repertoire
Workbooks.Open (Chemin & Dir(.Item(I)))
Cells.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
Workbooks("TEST RECUP FICHIER.xls").Activate
Sheets("Mise en forme").Visible = True
Sheets("Mise en forme").Activate
Range("C1").Select
ActiveSheet.PasteSpecial
End If
Next I
End With
End If
End With
End Sub
Bonsoir,
J'ai créé avec l'aide du FORUM une macro qui va récupérer les données contenues dans un répertoire dont le nom est défini en fonction d'une date.
Le chemin d'accès au répertoire est renseigné dans la cellule F9 de mon fichier.
Le fichier rechercher au format .txt commence par TI43.T00 (des fois en majuscule, des fois en minuscule).
Ce que je souhaite faire c'est demander au système de rechercher le répertoire en question.
Si celui-ci est introuvable : message d'alerte et sortie de la macro
Si celui-ci est trouvé mais que le fichier .txt est introuvable : message d'alerte et sortie de la macro
Si le fichier est trouvé l'ouvrir, copier l'intégralité du contenu et copier ce contenu dans la cellule C1 de la feuille "mise en forme".
L'idéal serait de fermer le fichier .txt qui ne sert plus à rien.
La macro que j'avais adaptée et qui fonctionnait à peu près ne marche plus....Je l'ai tellement modifiée que je ne sais plus où j'en suis.
Je mets en PJ un fichier test et un répertoire.
Si quelqu'un peut m'aider..
Merci d'avance
Cordialement
Ma macro actuelle est la suivante:
Sub RécupérerFichier()
Application.ScreenUpdating = True
MsgBox "Traitement des données en cours. Merci de patienter quelques instantes"
Application.ScreenUpdating = False
Dim ChercheFichier As FileSearch
Dim Chemin As String
Dim I As Integer
Dim debut
Dim ouvr
Chemin = ThisWorkbook.Sheets("MENU").Range("F9").Value
Set ChercheFichier = Application.FileSearch
Chemin = ThisWorkbook.Sheets("MENU").Range("F9").Value
With ChercheFichier
.NewSearch
.Filename = "*.txt"
.LookIn = Chemin
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
debut = Left(Dir(.Item(I)), 8)
If debut = "TI43.T00" Then
' a adapter selon emplacement repertoire
Workbooks.Open (Chemin & Dir(.Item(I)))
Cells.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
Workbooks("TEST RECUP FICHIER.xls").Activate
Sheets("Mise en forme").Visible = True
Sheets("Mise en forme").Activate
Range("C1").Select
ActiveSheet.PasteSpecial
End If
Next I
End With
End If
End With
End Sub
Pièces jointes
Dernière édition: