Posez votre question Signaler

Extraction fichier TXT [Résolu]

Messages postés
15
Date d'inscription
lundi 6 mars 2017
Dernière intervention
22 octobre 2017
 -
VBA Office (Excel, Word ...) Posez votre question Signaler
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
Afficher la suite 

Votre réponse

Répondre au sujet

1 réponse

Signaler Commenter la réponse de Patrice33740
Messages postés
7632
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
22 février 2019
 16
0
Merci
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

Afficher les 6 commentaires
Signaler Commenter la réponse de Patrice33740
Patrice33740
Messages postés
7632
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
22 février 2019
 16 -
Il n'y a pas de tri dans ta macro !
Signaler Commenter la réponse de doudou080
doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
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
Signaler Commenter la réponse de Patrice33740
Patrice33740
Messages postés
7632
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
22 février 2019
 16 > doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
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
Signaler Commenter la réponse de doudou080
doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Dernière intervention
22 octobre 2017
 > Patrice33740
Messages postés
7632
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
22 février 2019
 -
votre fichier fonctionne a merveille.

c'est juste la conversion du fichier TXT qui ne corespond pas a ce que j'avais au depart.
Signaler Commenter la réponse de Patrice33740
Patrice33740
Messages postés
7632
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
22 février 2019
 16 > doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Dernière intervention
22 octobre 2017
 -
Au plaisir de te relire sur le Forum

Cordialement
Patrice
Commenter la réponse de Patrice33740

Votre réponse

Répondre au sujet
Posez votre question
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.