Tri et extraction en vbs

Question

Bonjour à tous,

Je commence à peine en VB donc merci d'avance de votre indulgence.

J'ai un repertoire (c:\local\fichiers) qui comporte des fichiers dont le format du nom est XXXXXX.YYYYYYY-E.*.
Je voudrait lister le répertoire est extaire dans un txt les fichiers qui n'ont pas le bloc YYYYYYY.
Je ne peux malheureusement pas baser mon tri sur le nombre de caractères.
Il faut absolument que je refléchisse en terme de "blocs" quand au nom de fichier.
Le premier bloc serait ce qui se trouve avant le premier point (ici les XXXXXX).
Le deuxième bloc serait ce qui se trouve après le point (ici les YYYYYYY).
Le troisième bloc serait ce qui se trouve derrière le - (ici le E).

Merci à tous de votre aide.

Je vous souhaite de joyeuses fêtes de fin d'année.

PCPT · Answer

salut, Option Explicit ' http://www.codyx.org/snippet_lister-tous-fichiers-repertoire_198.aspx Public Function GetFilesPathFromDirectory(ByVal sDir As String, ByRef aRet() As String, Optional ByVal sFilter As String = "*.txt") As Long ' GetFilesPathFromDirectory retourne -1 si aucun fichier trouvé ' sinon retourne la dimension du tableau, donc NB fichiers -1 (tableau commence à l'indice 0) ' init les résultats GetFilesPathFromDirectory = -1 Erase aRet If RightB$(sDir, 2) <> "" Then sDir = sDir & "" ' formate le chemin Dim sFile As String sFile = Dir(sDir & sFilter, vbHidden Or vbSystem) ' boucle sur tous les fichiers Do If LenB(sFile) Then GetFilesPathFromDirectory = GetFilesPathFromDirectory + 1 ReDim Preserve aRet(GetFilesPathFromDirectory) aRet(GetFilesPathFromDirectory) = sDir & sFile sFile = Dir End If Loop Until LenB(sFile) = 0 End Function Private Sub Command1_Click() Dim aResultat() As String Dim lRet As Long Dim i As Long lRet = GetFilesPathFromDirectory("C:\local\fichiers", aResultat(), "XXXXXX.*-E.*.txt") If lRet <> -1 Then For i = 0 To lRet If InStr(1, aResultat(i), "XXXXXX.YYYYYYY") = 0 Then Debug.Print "Fichier " & i + 1 & " = " & aResultat(i) Next i End If End Sub ++ PCPT [AFCK]

Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp

PCPT · Answer

quoi que çà serait peut-être plus If InStr(1, aResultat(i), ".YYYYYYY") = 0 Then

<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp

cs_JMO · Answer

Bonjour à tous, Bonjour PCPT, Ayant vu le mot vbs dans le titre, alors, Option Explicit Dim Path Path = "c:\local\fichiers" MsgBox ShowFolderList(Path),vbInformation,"Critère ok" Function ShowFolderList(strPath) Dim objFso, objFile, strListe, strListe1 Set objFso = CreateObject("Scripting.FileSystemObject") For Each objFile in objFso.GetFolder(strPath).Files Call SelectFile(objFile.Name) If SelectFile(objFile.Name) = True Then strListe = strListe &vbCr& objFile.Name Else strListe1 = strListe1 &vbCr& objFile.Name End If Next ShowFolderList = strListe MsgBox "Fichiers à exclure" &vbCr& strListe1 Set objFso = Nothing End Function Function SelectFile(strFile) Dim iPos iPos = InStr(1, strFile, "-") If iPos <> 0 Then If UBound(Split(Left(strFile, iPos-1),".")) <> 1 Then Else SelectFile = False Exit Function End If End If SelectFile = True End Function Quelles extensions de fichier faut-il inclure pour lire et écrire dans un .txt an append ??? jean-marc

cs_JMO · Answer

re,
petite correction:

If iPos <> 0 Then
   If UBound(Split(Left(strFile, iPos-1),".")) = 1 Then
      SelectFile = False
      Exit Function
   End If
End If

jean-marc

PCPT · Answer

oups je n'avais pas vu VBS, heureusement qu'il y a des catégories 

bien vu JMO (bonjour)
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp

cs_JMO · Answer

Bonjour à tous, Cet exemple devrait aider Nulsat. Fichiers exclus: aaa.sauv1-fichier2.txt sa.uv-alert_pro.txt sss.sauv1-fichier.test2-aaa.txt Fichiers inclus et copiés en append dans C:\RESULTAT: bbb.aaa.sauv2-fichier1.txt bbb.aaa.sauv2-fichier1.ccc.txt resultat.txt sauv-test.txt sauv.test.txt Option Explicit Dim Path Path = "c:\local\fichiers" MsgBox ShowFolderList(Path),vbInformation,"Fichiers mis en append dans C:\RESULTAT" Function ShowFolderList(strPath) Dim objFso, objFile, strFilesInclus, strFilesExclus, imax Set objFso = CreateObject("Scripting.FileSystemObject") imax = 0 For Each objFile in objFso.GetFolder(strPath).Files If UCase(objFso.GetExtensionName(objFile)) = "TXT" Then Call SelectFile(objFile.Name) If SelectFile(objFile.Name) = True Then ReDim Preserve arrFiles(imax) arrFiles(imax) = objFile.Path imax = imax + 1 strfilesInclus = strFilesInclus &vbCr& objFile.Name Else strFilesExclus = strFilesExclus &vbCr& objFile.Name End If End If Next MsgBox strFilesExclus,,"Fichiers txt exclus" Call ReadFiles(arrFiles) ShowFolderList = strFilesInclus Set objFso = Nothing End Function Function SelectFile(strFile) Dim iPos iPos = InStr(1, strFile, "-") If iPos <> 0 Then If UBound(Split(Left(strFile, iPos-1),".")) = 1 Then SelectFile = False Exit Function End If End If SelectFile = True End Function Function ReadFiles(arrFiles)Const ForReading 1,ForWriting 2 Dim objFso, objTextResult, i Set objFso = CreateObject("Scripting.FileSystemObject") Set objTextResult = objFso.OpenTextFile("C:\RESULTAT.txt", 2, True) 'Lecture du Tableau de fichier For i = LBound(arrFiles) To UBound(arrFiles) Dim objTextFile, strLines 'Ouverture en lecture du fichier issu du tableau Set objTextFile = objFso.OpenTextFile(arrFiles(i),ForReading) 'Verif si fichier non vide If objFso.GetFile(arrFiles(i)).Size <> 0 Then strLines = objTextFile.ReadAll 'Ecriture fichier result objTextResult.Write strLines End If objTextFile.Close Set objTextFile = Nothing Next objTextResult.Close Set objTextResult = Nothing Set objFso = Nothing End Function jean-marc

Tri et extraction en vbs

6 réponses

Votre réponse

Discussions similaires