1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. VBA Office (Excel, Word ...)
Sujet Précédent Sujet Suivant

Extraction fichier TXT

Résolu
doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017
 - Modifié le 22 oct. 2017 à 14:14
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
 - 23 oct. 2017 à 09:27
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
A voir également:

1 réponse

Réponse 1 / 1
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
 21
22 oct. 2017 à 15:34
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

0
doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017
22 oct. 2017 à 18:01
bonjour

merci de votre aide

c'est tout a fait ce que je cherche.

par contre j'ai deux colonnes qui ne sont plus triées: K et M.

c'est certainement parce que j'ai des colonnes masquées:i j L N
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
 21
22 oct. 2017 à 19:05
Il n'y a pas de tri dans ta macro !
0
doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017
22 oct. 2017 à 19:10
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
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
 21 > doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017
22 oct. 2017 à 19:52
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
0
doudou080
Messages postés
15
Date d'inscription
lundi 6 mars 2017
Statut
Membre
Dernière intervention
22 octobre 2017
 > Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
22 oct. 2017 à 20:09
votre fichier fonctionne a merveille.

c'est juste la conversion du fichier TXT qui ne corespond pas a ce que j'avais au depart.
0