Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Lire et écrire dans un fichier avec 1 condition dans une boucle

3 réponses
Avatar
---DGI972---
Bonjour,

Je n'arrive pas a m'en sortie dans mon test dans ma boucle ainsi que la
lecture et l'écriture dans un fichier ( je sais sais la honte pour moi !!!).

Le pb est trés simple:
J'ai un fichier dans C:\TIP\TRANS\0_SQQQ.PAC
Je teste si il est présent,
je crée un un nouveau fichier avec un quantième du jour.
Je recopie ligne par ligne en testant si le début de la ligne est un 1
si oui je vais une petite invertion de zone et un remplissage de
888888888888, si non je recopie chaque ligne à l'identique.

voici mon bout de VBCript ou est le pb SVP ...

Option Explicit
Dim fso, objShell, QUANT, ID, A, B, C, fileIn, fileOut, Sline,StrIn

QUANT=Date()-DateSerial(Year(Date()),1,1)+1 'Fabrication du quantième
if QUANT<100 then QUANT="0"&QUANT 'Quantième sur 3 caractères
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

If fso.FileExists("C:\TIP\TRANS\0_SQQQ.PAC")= False Then
MsgBox "Il n'y a pas de fichier 0_S a traiter !!!" & vbCrLf & "" &
vbCrLf & "VEUILLEZ VERIFIER VOS TRANSFERTS" & vbCrLf & "" & vbCrLf &
"FERMEZ LE BAT POUR NE PAS CONTINUER LE TRANSFERT", vbOKOnly +
vbInformation, "PAS DE FICHIER"
Wscript.quit
End If

Set fileIn = fso.OpenTextFile("C:\TIP\TRANS\0_SQQQ.PAC", 1, True)
Set fileOut = fso.OpenTextFile("C:\TIP\TRANS\0_S"&QUANT&".PAC", 2, True)

Do While Not fileIn.AtEndOfStream
SLine = fileIn.Readline
ID=Mid(SLine,1,1) 'ID = Identification Début de ligne 0 1 ou 4'
If ID ="1" then
A=Mid(Sline,2,12) '12 X O
B="888888888888" '12 X 8
C=Mid(Sline,26,12) '12 X N°COMPTE
strIn=ID 'Début de ligne 1
strIn=strIn & A '12 caractères suivants
strIn=strIn & C 'Invertion de la zone C et B
strIn=strIn & B '12 X 8
strIn=strIn & Mid(SLine,38,43) 'Reste de la ligne
Set fileOut = fso.OpenTextFile("C:\TIP\TRANS\0_S"&QUANT&".PAC", 2, True)
fileOut.Write strIn
End If
Loop
Else
fileOut.WriteLine strIn

fileOut.Close

Set fileIn = Nothing 'pour décharger la variable pour pouvoir suprimer
fso.DeleteFile("C:\TIP\TRANS\0_SQQQ.PAC")
Set ID = Nothing
Set fso = Nothing
Set objShell = Nothing
Set fileIn = Nothing
Set fileOut = Nothing

3 réponses

Avatar
Georges MAUREL
Bonjour,
A première vue,
la partie
"Else
fileOut.WriteLine strIn"
devrait se trouver avant "loop"
et il faudrait aussi un "end if"

il faudrait donc
....
Else
fileOut.WriteLine strIn
end if
loop
...

Cordialement
Georges


"---DGI972---" <gilles.dermigny@*NOSPAM*laposte.net> a écrit dans le message
de news:
Bonjour,

Je n'arrive pas a m'en sortie dans mon test dans ma boucle ainsi que la
lecture et l'écriture dans un fichier ( je sais sais la honte pour moi
!!!).


Le pb est trés simple:
J'ai un fichier dans C:TIPTRANS_SQQQ.PAC
Je teste si il est présent,
je crée un un nouveau fichier avec un quantième du jour.
Je recopie ligne par ligne en testant si le début de la ligne est un 1
si oui je vais une petite invertion de zone et un remplissage de
888888888888, si non je recopie chaque ligne à l'identique.

voici mon bout de VBCript ou est le pb SVP ...

Option Explicit
Dim fso, objShell, QUANT, ID, A, B, C, fileIn, fileOut, Sline,StrIn

QUANTÚte()-DateSerial(Year(Date()),1,1)+1 'Fabrication du quantième
if QUANT<100 then QUANT="0"&QUANT 'Quantième sur 3 caractères
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

If fso.FileExists("C:TIPTRANS_SQQQ.PAC")= False Then
MsgBox "Il n'y a pas de fichier 0_S a traiter !!!" & vbCrLf & "" &
vbCrLf & "VEUILLEZ VERIFIER VOS TRANSFERTS" & vbCrLf & "" & vbCrLf &
"FERMEZ LE BAT POUR NE PAS CONTINUER LE TRANSFERT", vbOKOnly +
vbInformation, "PAS DE FICHIER"
Wscript.quit
End If

Set fileIn = fso.OpenTextFile("C:TIPTRANS_SQQQ.PAC", 1, True)
Set fileOut = fso.OpenTextFile("C:TIPTRANS_S"&QUANT&".PAC", 2, True)

Do While Not fileIn.AtEndOfStream
SLine = fileIn.Readline
ID=Mid(SLine,1,1) 'ID = Identification Début de ligne 0 1 ou 4'
If ID ="1" then
A=Mid(Sline,2,12) '12 X O
B="888888888888" '12 X 8
C=Mid(Sline,26,12) '12 X N°COMPTE
strIn=ID 'Début de ligne 1
strIn=strIn & A '12 caractères suivants
strIn=strIn & C 'Invertion de la zone C et B
strIn=strIn & B '12 X 8
strIn=strIn & Mid(SLine,38,43) 'Reste de la ligne
Set fileOut = fso.OpenTextFile("C:TIPTRANS_S"&QUANT&".PAC", 2, True)
fileOut.Write strIn
End If
Loop
Else
fileOut.WriteLine strIn

fileOut.Close

Set fileIn = Nothing 'pour décharger la variable pour pouvoir suprimer
fso.DeleteFile("C:TIPTRANS_SQQQ.PAC")
Set ID = Nothing
Set fso = Nothing
Set objShell = Nothing
Set fileIn = Nothing
Set fileOut = Nothing


Avatar
Georges MAUREL
Re bonjour,
en fait j'ai répondu un peu vite :
Voici comment devrait être la boucle do while

Do While Not fileIn.AtEndOfStream
SLine = fileIn.Readline
ID=Mid(SLine,1,1) 'ID = Identification Début de ligne 0 1 ou 4'
If ID ="1" then
A=Mid(Sline,2,12) '12 X O
B="888888888888" '12 X 8
C=Mid(Sline,26,12) '12 X N°COMPTE
strIn=ID 'Début de ligne 1
strIn=strIn & A '12 caractères suivants
strIn=strIn & C 'Invertion de la zone C et B
strIn=strIn & B '12 X 8
strIn=strIn & Mid(SLine,38,43) 'Reste de la ligne
fileOut.WriteLine strIn
else
fileOut.WriteLine SLine
End If
Loop

Cordialement
Georges



"---DGI972---" <gilles.dermigny@*NOSPAM*laposte.net> a écrit dans le message
de news:
Bonjour,

Je n'arrive pas a m'en sortie dans mon test dans ma boucle ainsi que la
lecture et l'écriture dans un fichier ( je sais sais la honte pour moi
!!!).


Le pb est trés simple:
J'ai un fichier dans C:TIPTRANS_SQQQ.PAC
Je teste si il est présent,
je crée un un nouveau fichier avec un quantième du jour.
Je recopie ligne par ligne en testant si le début de la ligne est un 1
si oui je vais une petite invertion de zone et un remplissage de
888888888888, si non je recopie chaque ligne à l'identique.

voici mon bout de VBCript ou est le pb SVP ...

Option Explicit
Dim fso, objShell, QUANT, ID, A, B, C, fileIn, fileOut, Sline,StrIn

QUANTÚte()-DateSerial(Year(Date()),1,1)+1 'Fabrication du quantième
if QUANT<100 then QUANT="0"&QUANT 'Quantième sur 3 caractères
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

If fso.FileExists("C:TIPTRANS_SQQQ.PAC")= False Then
MsgBox "Il n'y a pas de fichier 0_S a traiter !!!" & vbCrLf & "" &
vbCrLf & "VEUILLEZ VERIFIER VOS TRANSFERTS" & vbCrLf & "" & vbCrLf &
"FERMEZ LE BAT POUR NE PAS CONTINUER LE TRANSFERT", vbOKOnly +
vbInformation, "PAS DE FICHIER"
Wscript.quit
End If

Set fileIn = fso.OpenTextFile("C:TIPTRANS_SQQQ.PAC", 1, True)
Set fileOut = fso.OpenTextFile("C:TIPTRANS_S"&QUANT&".PAC", 2, True)

Do While Not fileIn.AtEndOfStream
SLine = fileIn.Readline
ID=Mid(SLine,1,1) 'ID = Identification Début de ligne 0 1 ou 4'
If ID ="1" then
A=Mid(Sline,2,12) '12 X O
B="888888888888" '12 X 8
C=Mid(Sline,26,12) '12 X N°COMPTE
strIn=ID 'Début de ligne 1
strIn=strIn & A '12 caractères suivants
strIn=strIn & C 'Invertion de la zone C et B
strIn=strIn & B '12 X 8
strIn=strIn & Mid(SLine,38,43) 'Reste de la ligne
Set fileOut = fso.OpenTextFile("C:TIPTRANS_S"&QUANT&".PAC", 2, True)
fileOut.Write strIn
End If
Loop
Else
fileOut.WriteLine strIn

fileOut.Close

Set fileIn = Nothing 'pour décharger la variable pour pouvoir suprimer
fso.DeleteFile("C:TIPTRANS_SQQQ.PAC")
Set ID = Nothing
Set fso = Nothing
Set objShell = Nothing
Set fileIn = Nothing
Set fileOut = Nothing


Avatar
---DGI972---
Re bonjour,
en fait j'ai répondu un peu vite :
Voici comment devrait être la boucle do while

Do While Not fileIn.AtEndOfStream
SLine = fileIn.Readline
ID=Mid(SLine,1,1) 'ID = Identification Début de ligne 0 1 ou 4'
If ID ="1" then
A=Mid(Sline,2,12) '12 X O
B="888888888888" '12 X 8
C=Mid(Sline,26,12) '12 X N°COMPTE
strIn=ID 'Début de ligne 1
strIn=strIn & A '12 caractères suivants
strIn=strIn & C 'Invertion de la zone C et B
strIn=strIn & B '12 X 8
strIn=strIn & Mid(SLine,38,43) 'Reste de la ligne
fileOut.WriteLine strIn
else
fileOut.WriteLine SLine
End If
Loop

Cordialement
Georges



"---DGI972---" <gilles.dermigny@*NOSPAM*laposte.net> a écrit dans le message
de news:

Bonjour,

Je n'arrive pas a m'en sortie dans mon test dans ma boucle ainsi que la
lecture et l'écriture dans un fichier ( je sais sais la honte pour moi


!!!).

Le pb est trés simple:
J'ai un fichier dans C:TIPTRANS_SQQQ.PAC
Je teste si il est présent,
je crée un un nouveau fichier avec un quantième du jour.
Je recopie ligne par ligne en testant si le début de la ligne est un 1
si oui je vais une petite invertion de zone et un remplissage de
888888888888, si non je recopie chaque ligne à l'identique.

voici mon bout de VBCript ou est le pb SVP ...

Option Explicit
Dim fso, objShell, QUANT, ID, A, B, C, fileIn, fileOut, Sline,StrIn

QUANTÚte()-DateSerial(Year(Date()),1,1)+1 'Fabrication du quantième
if QUANT<100 then QUANT="0"&QUANT 'Quantième sur 3 caractères
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

If fso.FileExists("C:TIPTRANS_SQQQ.PAC")= False Then
MsgBox "Il n'y a pas de fichier 0_S a traiter !!!" & vbCrLf & "" &
vbCrLf & "VEUILLEZ VERIFIER VOS TRANSFERTS" & vbCrLf & "" & vbCrLf &
"FERMEZ LE BAT POUR NE PAS CONTINUER LE TRANSFERT", vbOKOnly +
vbInformation, "PAS DE FICHIER"
Wscript.quit
End If

Set fileIn = fso.OpenTextFile("C:TIPTRANS_SQQQ.PAC", 1, True)
Set fileOut = fso.OpenTextFile("C:TIPTRANS_S"&QUANT&".PAC", 2, True)

Do While Not fileIn.AtEndOfStream
SLine = fileIn.Readline
ID=Mid(SLine,1,1) 'ID = Identification Début de ligne 0 1 ou 4'
If ID ="1" then
A=Mid(Sline,2,12) '12 X O
B="888888888888" '12 X 8
C=Mid(Sline,26,12) '12 X N°COMPTE
strIn=ID 'Début de ligne 1
strIn=strIn & A '12 caractères suivants
strIn=strIn & C 'Invertion de la zone C et B
strIn=strIn & B '12 X 8
strIn=strIn & Mid(SLine,38,43) 'Reste de la ligne
Set fileOut = fso.OpenTextFile("C:TIPTRANS_S"&QUANT&".PAC", 2, True)
fileOut.Write strIn
End If
Loop
Else
fileOut.WriteLine strIn

fileOut.Close

Set fileIn = Nothing 'pour décharger la variable pour pouvoir suprimer
fso.DeleteFile("C:TIPTRANS_SQQQ.PAC")
Set ID = Nothing
Set fso = Nothing
Set objShell = Nothing
Set fileIn = Nothing
Set fileOut = Nothing




J'ai testé cela fonctionne.


Merci encore