Tri et extraction en vbs

Signaler
Messages postés
9
Date d'inscription
mardi 7 août 2007
Statut
Membre
Dernière intervention
25 février 2008
-
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
-
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.

6 réponses

Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
43
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]
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
43
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
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 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
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
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
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
43
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
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 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