Le code exploite des fichiers et récupère que certaines informations pour les reformater, ce script vb permet de recuperer les sortie d'un outil qui génére un fichier texte (inexploitable tel quel)
Source / Exemple :
Sub tri_TXT(sInput,sOutput)
Dim inputfile,outpufile
Dim FdInput,dfich_source
Dim tmp
inputfile=sInput
outpufile=sOutput
'ouverture des 2 fichiers texte
Set FdInput = CreateObject("Scripting.FileSystemObject")
Set dfich_source = FdInput.OpenTextFile(inputfile, 1, False)
Dim imax,Cible,Valeur,j
imax = 0
Do While not dfich_source.atEndOfStream
imax = imax + 1
tmp = dfich_source.readLine
ReDim Preserve Tableau(1, imax)
Tableau(1, imax) = tmp
Valeur=0
j=imax - 1
Do while ((Valeur=0) and (j > 0))
If Tableau(1, j) > Tableau(1, j + 1) Then
Cible = Tableau(1, j)
Tableau(1, j) = Tableau(1, j + 1)
Tableau(1, j + 1) = Cible
Else
Valeur=1
End If
j=j-1
Loop
Loop
Dim FdOutput,dnouv_fich
Set FdOutput = CreateObject("Scripting.FileSystemObject")
Set dnouv_fich = FdOutput.CreateTextFile(outpufile)
dnouv_fich.Close
Set dnouv_fich = FdOutput.OpenTextFile(outpufile, 2, true)
Dim r
For r = 1 To imax
dnouv_fich.writeLine Tableau(1, r)
Next
dnouv_fich.Close
dfich_source.Close
Set dnouv_fich=nothing
Set dfich_source=nothing
Set FdOutput=nothing
Set FdInput=nothing
End sub
Sub doubl_TXT(sInput,sOutput)
Dim inputfile,outpufile
Dim FdInput,dfich_source
Dim tmp
inputfile=sInput
outpufile=sOutput
'ouverture des 2 fichiers texte
Set FdInput = CreateObject("Scripting.FileSystemObject")
Set dfich_source = FdInput.OpenTextFile(inputfile, 1, False)
Dim imax,Cible,Valeur,j
imax = 0
'1er elt inserer sans verification
if not dfich_source.atEndOfStream then
imax = imax + 1
tmp = dfich_source.readLine
ReDim Preserve Tableau(1, imax)
Tableau(1, imax) = tmp
end if
Do While not dfich_source.atEndOfStream
'ne fonctionne que si le fichier est trié
tmp = dfich_source.readLine
If (Tableau(1, imax) <> tmp) then
imax = imax + 1
ReDim Preserve Tableau(1, imax)
Tableau(1, imax) = tmp
End if
Loop
Dim FdOutput,dnouv_fich
Set FdOutput = CreateObject("Scripting.FileSystemObject")
Set dnouv_fich = FdOutput.CreateTextFile(outpufile)
dnouv_fich.Close
Set dnouv_fich = FdOutput.OpenTextFile(outpufile, 2, true)
Dim r
For r = 1 To imax
dnouv_fich.writeLine Tableau(1, r)
Next
dnouv_fich.Close
dfich_source.Close
Set dnouv_fich=nothing
Set dfich_source=nothing
Set FdOutput=nothing
Set FdInput=nothing
End sub
Sub recup_ligne_TXT(sChaine,ileft,iright,sInput,sOutput)
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Dim text
Dim tmp
Dim nbre_ligne_fichier,iPos
Dim gauche,droite,reste,somme
Dim FSys,FInput,fich_source,nouv_fich
Dim filein
Dim fileout
'Dim fileout As String
filein=sInput
fileout=sOutput
'CREATION FICHIER TEMPORAIRE
Set FSys = CreateObject("Scripting.FileSystemObject")
Set nouv_fich = FSys.CreateTextFile(fileout)
'FERMETURE FICHIER TEMPORAIRE
nouv_fich.Close
'ouverture des 2 fichiers texte
' Open filein For Input As 1#
' Open fileout For Output As 2#
Set FInput = CreateObject("Scripting.FileSystemObject")
Set fich_source = FInput.OpenTextFile(filein, 1, False)
Set nouv_fich = FSys.OpenTextFile(fileout, 2, true)
'wscript.echo "Debug Debut lecture" & ileft & iright
Do While not fich_source.atEndOfStream
'compteur = compteur + 1
tmp = fich_source.readLine
'wscript.echo "Debug read " & tmp
iPos = InStr(1, tmp, sChaine)
'wscript.echo "Debug if iPos "
'Do While not fich_source.atEndOfStream
if iPos <> 0 then
'wscript.echo "Debug """ & ileft & iright
If iright = -1 then 'on prend tout à droite de la chaine
somme = Len(tmp) - iPos - Len(sChaine) + 1
'wscript.echo "Debug ipos """ & iPos
'wscript.echo "Debug """ & somme
droite = right(tmp,somme)
nouv_fich.writeLine droite
end if
If ileft = -1 then 'on prend tout à gauche de la chaine
'wscript.echo "Debug ipos """ & iPos
'wscript.echo "Debug """ & somme
gauche = left(tmp,iPos)
nouv_fich.writeLine gauche
end if
'on prend tout à iright carateres à droite et ileft à gauche de la chaine
If iright =0 and ileft>=0 then
reste=tmp
'wscript.echo "Debug left " & somme
Do while (iPos <>0 )
'wscript.echo "Debug iPos """ & iPos
'wscript.echo "Debug """ & ileft
somme = Len(reste) - iPos - Len(sChaine) + 1
if ileft > iPos then
gauche = left(reste,iPos-1)
reste = right(reste,somme)
'wscript.echo "Debug left1" & gauche
'wscript.echo "Debug left1" & reste
else
gauche = right(left(reste,iPos-1),ileft)
reste = right(reste,somme)
'wscript.echo "Debug left2 " & gauche
'wscript.echo "Debug left2" & reste
End if
'wscript.echo "Debug " & gauche & droite
tmp = Trim(gauche)
nouv_fich.writeLine tmp
iPos = InStr(1, reste, sChaine)
Loop
end if
If iright >=0 and ileft=0 then
reste=tmp
'wscript.echo "Debug right """ & somme
Do while (iPos <>0 )
somme = Len(reste) - iPos - Len(sChaine) + 1
'wscript.echo "Debug somme """ & somme
'wscript.echo "Debug """ & iright
if iright > somme then
droite = right(reste,somme)
'wscript.echo "Debug right1" & droite
else
droite = left(right(reste,somme),iright)
somme = Len(reste) - iPos - Len(sChaine) + 1 - Len(droite)
reste = right(right(reste,somme),somme)
'wscript.echo "Debug right2" & droite
'wscript.echo "Debug right2" & reste
end if
'wscript.echo "Debug " & droite
tmp = Trim(droite)
nouv_fich.writeLine tmp
iPos = InStr(1, reste, sChaine)
Loop
end if
end if
Loop
'fermeture des 2 fichiers texte
'Close #1
'Close #2
nouv_fich.close
fich_source.close
Set nouv_fich=nothing
Set fich_source=nothing
Set FSys=nothing
Set FInput=nothing
'Supprmime le fichier SOURCE
'Kill filein
'Renomme le fichier TEMP(et donc remplace le fichier SOURCE)
'Name fileout As filein
'If N°ligne > nbre_ligne_fichier Or N°ligne < 1 Then MsgBox "Procédure exécutée avec succès, mais sans effet!", vbInformation, "Message"
'wscript.echo "Debug fin recupligne "
End Sub
Sub bloc_TXT(sChainedeb,sChainefin,tInput,tOutput)
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'recuperation des elements du fichiers compris entre la ligne contenant sChainedeb et la ligne sChainefin
Dim tmp
Dim iPos
Dim FOut,FIn,fich_source,nouv_fich
Dim filein
Dim fileout
'Dim fileout As String
filein=tInput
fileout=tOutput
'wscript.echo "Debug bloc_TXT input1 " & filein
'wscript.echo "Debug bloc_TXT input2 " & fileout
'CREATION FICHIER TEMPORAIRE
Set FOut = CreateObject("Scripting.FileSystemObject")
Set nouv_fich = FOut.CreateTextFile(fileout)
nouv_fich.Close
'ouverture des 2 fichiers texte
' Open filein For Input As 1#
' Open fileout For Output As 2#
Set FIn = CreateObject("Scripting.FileSystemObject")
Set fich_source = FIn.OpenTextFile(filein, 1, False)
Set nouv_fich = FOut.OpenTextFile(fileout, 2, true)
iPos =0
'wscript.echo "Debug Debut lecture" & ileft & iright
Do while (iPos =0) and not fich_source.atEndOfStream
tmp = fich_source.readLine
'wscript.echo "Debug bloc_TXT deb " & tmp
iPos = InStr(1, tmp, sChainedeb)
'wscript.echo "Debug bloc_TXT deb " & iPos
Loop
iPos =0
Do while (iPos =0) and not fich_source.atEndOfStream
tmp = fich_source.readLine
wscript.echo "Debug bloc_TXT fin " & tmp
iPos = InStr(1, tmp, sChainefin)
'wscript.echo "Debug bloc_TXT fin " & iPos
If iPos = 0 then
nouv_fich.writeLine tmp
End if
Loop
nouv_fich.close
fich_source.close
Set nouv_fich=nothing
Set fich_source=nothing
Set FOut=nothing
Set FIn=nothing
End Sub
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.