Supprimer une ligne fichier txt depuis vba

**RomBon** · 15/11/2018, 14h12

Bonjour le forum,
Je suis en train de créer une macro qui permet d'importer les données d'un fichier texte dans Excel. Mais il y a plus de lignes dans le fichier txt que de lignes dispos dans un excel .xlsx
Dans la logique, voilà comment je procéde :
1. Ouvrir le txt
2. Supprimer le slignes contenant "Data" (ou un autre mot, je dois définir cela) du fichier txt
3. recopier le slignes sur excel
4. Fermer le fichier txt

Je viens de terminer la macro à l'aide d'autre sposts sur le forum mais je bloque sur un paramètre : Lorsque je demande d'identifier les lignes contenant "Data", il ne les trouve pas et recopie en intégralité les données du txt.
Voici ma macro ci dessous (uniquement pour supprimer les lignes contenant data, pas pour coller dans excel) avec le fichier txt associé. Pouvez-vous me donner un petit coup de main svp?
Merci à vous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
'Supprimer des lignes inutiles pour exécuter dans excel
Sub test()
 
 
 
Dim myFso As Object, Fichier1 As Object, Fichier2 As Object
Dim pathFichierTxt As String, pathNouvFichierTxt As String, LigneTxt As String
 
pathFichierTxt = "C:\Users\chemin\Nouveau document texte.txt"
pathNouvFichierTxt = Left(pathFichierTxt, InStrRev(pathFichierTxt, "\")) & "tmp_" & Format(Now, "yyyymmddhhnnss") & ".txt"
Set myFso = CreateObject("Scripting.FileSystemObject")
Set Fichier1 = myFso.OpenTextFile(pathFichierTxt, 1)
Set Fichier2 = myFso.CreateTextFile(pathNouvFichierTxt, True)
 
While Not Fichier1.AtEndOfStream
    LigneTxt = Fichier1.ReadLine
    'If Not UCase(LigneTxt) Like "Data" Then Fichier2.WriteLine LigneTxt
    If InStr(UCase(LigneTxt), "Data") = 0 Then Fichier2.WriteLine LigneTxt
Wend
Fichier1.Close
Fichier2.Close
myFso.DeleteFile pathFichierTxt, True
Name pathNouvFichierTxt As pathFichierTxt
Set myFso = Nothing
Set Fichier1 = Nothing
Set Fichier2 = Nothing
 
 
End Sub

**Pierre Fauconnier** · 15/11/2018, 14h34

Salut

Ta demande consistant à ouvrir un txt pour récupérer certaines lignes dans Excel, je ne compends pas pourquoi tu essaies de les écrire dans un autre txt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Test()
  Dim Channel As Long
  Dim TxtLine As String
  Dim FileName As String
  Dim r As Range
 
  Set r = Range("a1")
  FileName = "n:\test.txt"
  Channel = FreeFile
  Open FileName For Input As Channel
  Do While Not EOF(Channel)
    Line Input #Channel, TxtLine
    If InStr(1, TxtLine, "data", vbTextCompare) > 0 Then
      r.Value = TxtLine
      Set r = r(2)
    End If
  Loop
  Close #Channel
End Sub

**RomBon** · 15/11/2018, 14h43

Bonjour, et merci pour la réponse, ça fonctionne, le data est reconnu.
Par contre je ne parviens pas à supprimer la ligne qui contient "Data"...Est-ce normal ?
L'idée serait de supprimer la ligne pour pouvoir exporter les données par la suite (j'ai déjà le code pour l'export).

**Pierre Fauconnier** · 15/11/2018, 14h57

Ta demande initiale ne demandait pas de supprimer la ligne. De ce que j'ai compris de ta demande, tu veux récupérer dans Excel les lignes d'un fichier TXT en fonction de la présence du mot "Data" dans la ligne. Si tu souhaites autre chose, sois précis dans l'énoncé de ta demande...

**RomBon** · 15/11/2018, 15h00

Si, il faut supprimer la ligne, je reformule mon énoncé initial :
1. Ouvrir le txt
2. Supprimer les lignes contenant "Data" (ou un autre mot, je dois définir cela) du fichier txt
3. Recopier le reste des lignes sur excel (celles qui ne contiennent pas le mot data : qui n'ont donc pas été supprimées)
4. Fermer le fichier txt

**Pierre Fauconnier** · 15/11/2018, 15h05

Ok.

Il n'est pas possible de supprimer une ligne d'un fichier txt. Tu peux:

soit ouvrir un nouveau txt et y copier les bonnes lignes et les copier également dans XL, puis fermer ce fichier, supprimer l'ancien et renommer le nouveau;
soit copier les bonnes lignes dans Excel, supprimer l'ancien txt puis sauver le XL en txt.

**RomBon** · 15/11/2018, 15h08

Ok merci pour l'info.
La première solution correspond au code que j'ai envoyé au début de ce mail.
Il fonctionne bien sauf que dans cette boucle (ci-dessous), le code recopie toutes le slignes, même celles qui contiennent "Data".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
While Not Fichier1.AtEndOfStream
    LigneTxt = Fichier1.ReadLine
    'If Not UCase(LigneTxt) Like "Data" Then Fichier2.WriteLine LigneTxt
    If InStr(UCase(LigneTxt), "xml") = 0 Then Fichier2.WriteLine LigneTxt
Wend

C'est là où je bloque

**Pierre Fauconnier** · 15/11/2018, 15h10

Tu as dit précédemment que mon code fonctionnait correctement pour trouver les lignes "Data". Il te suffit donc d'insérer la ligne d'écriture dans le bloc IF mentionné dans mon code... non?

**RomBon** · 15/11/2018, 15h17

J'y travaille, mais je ne parviens à le faire tourner.

**Pierre Fauconnier** · 15/11/2018, 15h30

Donne ton code...

**RomBon** · 15/11/2018, 15h57

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Teust()
 
 
 
Dim myFso As Object, Fichier1 As Object, Fichier2 As Object
Dim pathFichierTxt As String, pathNouvFichierTxt As String, LigneTxt As String
 
Dim r As Range, channel As Long
 
  Set r = Range("a1")
 
pathFichierTxt = "C:\Users\test forum\Nouveau document texte.txt"
pathNouvFichierTxt = Left(pathFichierTxt, InStrRev(pathFichierTxt, "\")) & "tmp_" & Format(Now, "yyyymmddhhnnss") & ".txt"
Set myFso = CreateObject("Scripting.FileSystemObject")
Set Fichier1 = myFso.OpenTextFile(pathFichierTxt, 1)
Set Fichier2 = myFso.CreateTextFile(pathNouvFichierTxt, True)
 
channel = FreeFile
Open pathFichierTxt For Input As channel
 
            While Not Fichier1.AtEndOfStream
            LigneTxt = Fichier1.ReadLine
 
            'If Not UCase(LigneTxt) Like "Data" Then Fichier2.WriteLine LigneTxt
 
                If InStr(1, TxtLine, "Data", vbTextCompare) > 0 Then
                r.Value = TxtLine
                Set r = r(2)
                End If
 
            Wend
 
 
 
Fichier1.Close
Fichier2.Close
 
myFso.DeleteFile pathFichierTxt, True
Name pathNouvFichierTxt As pathFichierTxt
Set myFso = Nothing
Set Fichier1 = Nothing
Set Fichier2 = Nothing
 
 
End Sub

Supprimer une ligne fichier txt depuis vba

Macros et VBA Excel

Discussions similaires

Partager

Partager