Vbs trier dedoublonner recuperer des elements selectionner dans des fichiers

Soyez le premier à donner votre avis sur cette source.

Snippet vu 8 498 fois - Téléchargée 24 fois

Commenter

Contenu du snippet

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

A voir également

S'inscrire maintenant

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.