Extraction fichier TXT [Résolu]

Signaler
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017
-
Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
-
Bonjour à tous

de nouveau parmi vous pour un petit problème.

dans une macro je fait une conversion d'un fichier TXT.

ChDir "D:\moi\Gestion des reliquats"
    Workbooks.OpenText Filename:= _
        "D:\moi\Gestion des reliquats\TDOUAY_QSYSPRT_2017-10-06-083825.txt", Origin:= _
        xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, _
        1), Array(13, 1), Array(22, 1), Array(49, 1), Array(54, 1), Array(63, 1), Array(66, 1), _
        Array(81, 1), Array(90, 1), Array(110, 1), Array(119, 1), Array(126, 1), Array(135, 1), _
        Array(137, 1)), TrailingMinusNumbers:=True
    Range("A7:N100").Select
    ActiveWindow.SmallScroll Down:=-72
    Selection.Copy
    Windows("Gestion des reliquats.xlsm").Activate
    Range("B" & Cells(Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial xlPasteValues
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).Activate
    ActiveCell.FormulaR1C1 = "10/7/2017"
End Sub


sauf que ce fichier provient d'une extraction automatique qui tourne 2 fois par jour, ce qui fait que je n'ai plus le même non de fichier.

exemple: le matin ,  TDOUAY_QSYSPRT_2017-10-06-083825
: l'AP-midi, TDOUAY_QSYSPRT_2017-10-06-133825


ma question:

existe t'il un moyen que ma macro ne tienne pas compte de ce changement.
ou quelle prenne par défaut le fichier qui se trouve dans ce répertoire.?

cordialement votre

1 réponse

Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
21
Bonjour,

Essaies ce code :
Option Explicit
Sub Test()
Const adr$ = "A7:N100"
Dim wshSource As Worksheet
Dim wshCible As Worksheet
Dim rngCible As Range
Dim nomDossier As String
Dim nomFichier As String

  Set wshCible = Workbooks("Gestion des reliquats.xlsm").Worksheets(1)
  Set rngCible = wshCible.Cells(Rows.Count, "B").End(xlUp).Offset(1)
  Set rngCible = rngCible.Resize(Range(adr).Rows.Count, Range(adr).Columns.Count)
  nomDossier = "D:\moi\Gestion des reliquats\"
  nomFichier = Dir(nomDossier & "TDOUAY_QSYSPRT_2017*.txt")
  If nomFichier <> "" Then
    Workbooks.OpenText Filename:=nomDossier & nomFichier, Origin:=xlWindows, StartRow:=1, _
      DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(22, 1), Array(49, 1), _
      Array(54, 1), Array(63, 1), Array(66, 1), Array(81, 1), Array(90, 1), Array(110, 1), _
      Array(119, 1), Array(126, 1), Array(135, 1), Array(137, 1)), TrailingMinusNumbers:=True
    Set wshSource = ActiveSheet
    rngCible.Value = wshSource.Range(adr).Value
    wshSource.Parent.Close False
    rngCible.Cells(1, 1).Offset(0, -1).Formula = Date
  End If

End S
ub

Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
21
Il n'y a pas de tri dans ta macro !
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017

j'ai beau chercher je ne trouve pas.?

je ne m'y retrouve pas

serait il possible d’intégré a ma macro de depart :

votre code pour le choix du fichier:
nomDossier = "D:\moi\Gestion des reliquats\"
nomFichier = Dir(nomDossier & "TDOUAY_QSYSPRT_2017*.txt")

votre code pour la date:
rngCible.Cells(1, 1).Offset(0, -1).Formula = Date ?

cordialement votre
Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
21 >
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017

Non.
Ta macro de départ est très mal écrite, il faut absolument évite les Select, Activate, selection, ...

Mais je commenter le code :
Option Explicit
Sub xxx()
Const adr$ = "A7:N100"
Dim wshSource As Worksheet
Dim wshCible As Worksheet
Dim rngCible As Range
Dim nomDossier As String
Dim nomFichier As String

  'Définir la feuille cible
  Set wshCible = Workbooks("Gestion des reliquats.xlsm").Worksheets(1)
  'Définir la première cellule libre de la colonne B de la cible
  Set rngCible = wshCible.Cells(Rows.Count, "B").End(xlUp).Offset(1)
  'Définir la plage cible (qui recevra les valeurs)
  Set rngCible = rngCible.Resize(Range(adr).Rows.Count, Range(adr).Columns.Count)
  'Définir du nom du dossier
  nomDossier = "D:\moi\Gestion des reliquats\"
  'Checher dans le dossier, le nom du fichier qui commence par ...
  nomFichier = Dir(nomDossier & "TDOUAY_QSYSPRT_2017*.txt")
  If nomFichier <> "" Then
    'S'il existe un fichier correspondant, l'ouvrir
    Workbooks.OpenText Filename:=nomDossier & nomFichier, Origin:=xlWindows, StartRow:=1, _
      DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(22, 1), Array(49, 1), _
      Array(54, 1), Array(63, 1), Array(66, 1), Array(81, 1), Array(90, 1), Array(110, 1), _
      Array(119, 1), Array(126, 1), Array(135, 1), Array(137, 1)), TrailingMinusNumbers:=True
    'Definir la feuille source (qui contient les valeurs à copier)
    Set wshSource = ActiveSheet
    'Copier les valeurs de la source vers la cible
    rngCible.Value = wshSource.Range(adr).Value
    'Fermer le fichier source
    wshSource.Parent.Close False
    'Mettre la date colonne A, sur la première ligne des données copiées
    rngCible.Cells(1, 1).Offset(0, -1).Formula = Date
  End If

End Sub
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017
>
Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021

votre fichier fonctionne a merveille.

c'est juste la conversion du fichier TXT qui ne corespond pas a ce que j'avais au depart.
Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
21 >
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017

Au plaisir de te relire sur le Forum

Cordialement
Patrice