Enrichir ma macro pour récupérér les données d'un autre fichier

[chris6999]

Bonjour

J'ai récupéré sur un post une macro qui permet d'ouvrir un document externe à mon fichier excel

Ce que fait la macro

Elle ouvre un fichier dont les 8 premiers caractères sont TI43.too dans un répertoire dont le chemin est saisi dans la cellule F9 de la page MENU de mon fichier principal.
Les données du document TI43.too sont sélectionnées, copiées puis coller dans la feuille 2 de mon fichier principal.

Option Explicit

Sub ouverturefichier2()


Dim ChercheFichier As FileSearch
Dim Chemin As String
Dim I As Integer
Dim debut
Dim ouvr
Chemin = ThisWorkbook.Sheets("MENU").Range("F9").Value


On Error Resume Next

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

Workbooks.Open (Chemin & Dir(.Item(I)))
Cells.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy

Workbooks("Copie de classeur ouverture fichier").Activate
Sheets("Feuil2").Select
Range("C1").Select
On Error Resume Next 'sans tenir compte des messages d'erreur
'copier la sélection dans la cellue B1
ActiveSheet.PasteSpecial
End If

Next I
End With
End If
End With

End Sub
Tout ça fonctionne nickel mais je souhaiterais mettre une alerte notamment lorsque le chemin est invalide ou lorsque dans le chemin il n'existe pas de document commençant par TI43.too.

Du style msgbox "Aucun fichier n'est disponible à cette date" puis sortie de la macro

Autre question : je souhaiterais que le fichier Excel généré suite à la récupération des données se ferme automatiquement lorsque la macro s'achève.

je pensais à ajouter en fin de macro Workbooks.Open (Chemin & Dir(.Item(I))).close mais cela ne fonctionne pas

Quelqu'un peut-ilme venir en aide

Je mets en pièce jointe mon fichier excel et le fichier des données à récupérer

Merci d'avance

 

[Yaloo]

Re : Enrichir ma macro pour récupérér les données d'un autre fichier

Bonsoir Christelle,

A mon avis, il faut plutôt utiliser

On error Goto ...

On error Goto 0

Comme dans l'exemple ci-dessous

Sub Macro_qui_plante()
On Error GoTo Fin
  'Ta macro
  '....
On Error GoTo 0
  'Le reste de ta macro
  '....
  Exit Sub
Fin:
MsgBox "Aucun fichier n'est disponible à cette date"
End Sub

A te relire

Martial

PS : Deuxième question à voir plus tard

 

[kjin]

Re : Enrichir ma macro pour récupérér les données d'un autre fichier

bonsoir, salut Yaloo 🙂,
Il n'est pas utile d'utiliser FileSearch s'il n'y a qu'un seul fichier à ouvrir...

chemin = ThisWorkbook.Sheets("MENU").Range("F9").Value
If Dir(chemin) = "" Then
    MsgBox "le fichier ou le chemin n'existe pas"
    Exit Sub
End If

....et dans tous les cas mieux vaut utiliser le FSO
A+
kjin

 

[Yaloo]

Re : Enrichir ma macro pour récupérér les données d'un autre fichier

Salut kjin 😀,

J'avais lu vite fait. Tout à fait d'accord.

A+

 

[chris6999]

Re : Enrichir ma macro pour récupérér les données d'un autre fichier

Merci je vais essayer de tester ta proposition
Cordialement

 

[chris6999]

Re : Enrichir ma macro pour récupérér les données d'un autre fichier

Bonjour Kjin

Étant novice du VBA j'ai un peu de mal à raccrocher ta proposition à mon code actuel.
Je ne sais pas trop ce que je peux ou pas supprimer et où intégrer les modifications

Sans vouloir abuser de ta patiente, pourrais-tu m'aider stp?
Cordialement

Est-ce que je peux essayer comme ça?
Sub ouverturefichier2()


Dim ChercheFichier As FileSearch
Dim Chemin As String
Dim I As Integer
Dim debut
Dim ouvr
Chemin = ThisWorkbook.Sheets("MENU").Range("F9").Value
If Dir(chemin) = "" Then
MsgBox "le fichier ou le chemin n'existe pas"

'On Error Resume Next

else

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

Workbooks.Open (Chemin & Dir(.Item(I)))
Cells.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy

Workbooks("Copie de classeur ouverture fichier").Activate
Sheets("Feuil2").Select
Range("C1").Select
On Error Resume Next 'sans tenir compte des messages d'erreur
'copier la sélection dans la cellue B1
ActiveSheet.PasteSpecial
End If

Next I
End With
End If
End With

End Sub