Bonjour , je suis en train de remanier un fichier .txt via excel .(un petit mélange vba – vbscript)
Le but est de filtrer les bonnes bonnes lignes et de les envoyer vers un nouveau fichier .txt appelé TEST.txt . A la main cela donne je sélectionne une ligne et je la colle dans un autre fichier + entreé pour passer à la ligne suivante .
Cependant , je rencontre une série de bugs .
1 er bug les mauvaises lignes sont quand même envoyées vers le fichier TEST.txt
Ce if
ne filtre rien ..
2 ème bug les signes pipes | sont espacés , et il ne le faut pas*: la forme du nouveau fichier .txt doit rester strictement identique à celui d’origine
3ème bug au fur et à mesure que les lignes sont envoyées vers TEST.txt le retour à la ligne ne s’effectue pas .La dernière ligne écrasant la précédente .
Voici mon code , le fichier à manipuler est en pièce jointe
Le but est de filtrer les bonnes bonnes lignes et de les envoyer vers un nouveau fichier .txt appelé TEST.txt . A la main cela donne je sélectionne une ligne et je la colle dans un autre fichier + entreé pour passer à la ligne suivante .
Cependant , je rencontre une série de bugs .
1 er bug les mauvaises lignes sont quand même envoyées vers le fichier TEST.txt
Ce if
Code:
If CInt(Trim(Ar(3))) <> 0 Or CInt(Trim(Ar(3))) <> 200 Or CInt(Trim(Ar(3))) <> 1536 Then …2 ème bug les signes pipes | sont espacés , et il ne le faut pas*: la forme du nouveau fichier .txt doit rester strictement identique à celui d’origine
3ème bug au fur et à mesure que les lignes sont envoyées vers TEST.txt le retour à la ligne ne s’effectue pas .La dernière ligne écrasant la précédente .
Voici mon code , le fichier à manipuler est en pièce jointe
Code:
Option Explicit
Option Base 1
'le but du module et de nettoyer le fichier .txt
Sub nettoietxt(numomega)
'1/Vérifie que le dossier Pnumomega existe !
'1.1/Si il existe pas alors exit sub ne fait rien
Dim dossiercherche As String
dossiercherche = "P" & numomega
Dim MyFile As String
MyFile = Dir("C:\Documents and Settings\a\Bureau\Projet\" & dossiercherche, vbDirectory) 'vbdirectory se concentre sur les dossiers et exclu le reste
If Len(MyFile) > 0 Then ' si c'est supérieur à 0 alors le dossier existe
' et si le dossier existe alors le fichier .txt correspondant aussi
Call creertxt(dossiercherche)
Call lancenettoiebis(dossiercherche, MyFile)
Else
Exit Sub 'sinon quitte
End If
End Sub
Private Function creertxt(dossiercherche) '
Dim objfichier, monnouveaufichier As Variant
Set objfichier = CreateObject("Scripting.FileSystemObject")
Set monnouveaufichier = objfichier.CreateTextFile("C:\Documents and Settings\a\Bureau\Projet\" _
& dossiercherche & "\" & "TEST.txt", True) 'creer un fichier TEST.txt vide
'qui recevra uniquement les bonnes lignes
' les lignes seront copies une à une
' vers TEST.tx ensuite le mauvais est supprimé
'et TEST.txt est renommé sous le bon nom avec les bonnes lignes
Set objfichier = Nothing
Set monnouveaufichier = Nothing
End Function
Function lancenettoiebis(dossiercherche, MyFile)
Dim Chaine As String
Dim Ar() As String
Dim i, iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur As String
Separateur = Chr(124) ' Chr(124) '124 représent le signe pipe
'Cells.Clear
NumFichier = FreeFile ' 1/ Attribue un numéro de fichier
iRow = 1
'Open "C:\Documents and Settings\a\Bureau\Projet\" & dossiercherche & "\" & "TEST.txt" _
'For Input As #NumFichier 'ici imput# non pas imput tout court
Dim chemin As String
chemin = "C:\Documents and Settings\a\Bureau\Projet\" & dossiercherche & "\"
Open chemin & dossiercherche & ".txt" _
For Input As #NumFichier
Do While Not EOF(NumFichier) '3/ EOF (end of file) est une fonction importante
' tant que la lecture de la fin de fichier n'est pas atteinte
iCol = 1
Line Input #NumFichier, Chaine ' 3.1/Lit ligne par ligne le fichier ouvert en mode séquentiel
Debug.Print Chaine ' pour voir les chaines du fichiers text dans la console
Ar = Split(Chaine, Separateur, 5) ' 5 car j'aie besoin uniquement des 4 premieres séparations
If CInt(Trim(Ar(3))) <> 0 Or CInt(Trim(Ar(3))) <> 200 Or CInt(Trim(Ar(3))) <> 1536 Then
'if ne filtre rien !
'ouvre le fichier TEST et copie la variable chaine ds le fichier TEST.txt
Call ouvreetcopie(chemin, Chaine)
End If
iRow = iRow + 1
Loop
Close #NumFichier
End Function
Private Function ouvreetcopie(chemin, Chaine)
Dim NumFichier1 As Integer
NumFichier1 = FreeFile '
Open chemin & "TEST.txt" _
For Input As #NumFichier1
Dim fichierTEST, ecritdsfichier As Variant
'SetfichierTEST=CreateObject("Scripting.TextStream") 'fichierTEST.TextStream.WriteLine (Chaine) 'décevant je ne parviens pas à utiliser 'la méthode TextStream .Je me rabat donc sur la solution avec OpenTextFile
Set fichierTEST = CreateObject("Scripting.FileSystemObject")
Set ecritdsfichier = fichierTEST.OpenTextFile(chemin & "TEST.txt", ForWriting, True)
'erreur d'execution 5 argument ou appel de procèdure incorrect
ecritdsfichier.WriteLine Chaine & Chr(13) & Chr(10) ' Chr(13) & Chr(10) incompris le retour
' à la ligne n'est pas éffectué
Close #NumFichier1
Set fichierTEST = Nothing
Set ecritdsfichier = Nothing
End Function
