Vbs export sélectif fichier txt et importation dans un fichier existant

Etant fan de la clarté et de la lisibilité d'un texte, alors je te propose :

Pour une meilleure lisibilité du résultat, voici le code final avec les modifications apportées prenant en compte ma remarque du Post #18 et une mise en forme du résultat qui va surement te plaire(:koi:) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Option Explicit 
 
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, Fich1, Fich2, Ret, NewText(), tb, tmp, I, Result, aux, J
 
Set fso = CreateObject("Scripting.FileSystemObject")  
Set fich1 = fso.OpenTextFile("Source.txt", ForReading, False) 
 
I = 0
Do While Not fich1.AtEndOfStream
   Ret = fich1.ReadLine
   If InStr(LCase(Ret), Chr(34) & "d:\dossier") > 0 Then
       tb = Split(Ret, Chr(34) & "," & Chr(34))
      tmp = (Replace(Replace(tb(2), ",", ""), "MB", ""))/1024
      aux = Replace(Mid(tb(4), 1 ,InStr(1, tb(4), "%")), Chr(34), "")  
      ReDim Preserve NewText(I) ' Redimensionnement du tableau avec conservation de son contenu
      'On ajoute ici un indicateur de dossier qui servira dans la comparaison plus loin
      ' tb(0) où on remplace les guillemets (") par une chaine vide
      NewText(I) = Replace(tb(0), Chr(34), "") & "  quota de  " & FormatStr(CStr(tmp) & " GB", 9, 2) & "utilisé à  " & aux 
      I = I + 1
    End If
Loop
 
fich1.Close
Dim strFind, ID, strFind1
Result = ""
I = 1
Set fich2 = fso.OpenTextFile("Resultat.txt", ForReading, False)
Do While Not fich2.AtEndOfStream
   Ret = fich2.ReadLine
          strFind = Trim(Mid(Ret, 8 , 8 + Len(Cstr(I))))
          For J = 0 To Ubound(NewText)
            ' If NewText(J) <> "" Then 
                strFind1 = Trim(Mid(NewText(J), 1 ,13))
                ID = Len(strFind1) + 3
                If InStr(1, NewText(J), strFind) > 0 Then 
                  If Mid(strFind1, 4) = strFind Then  
                      Result = Result & FormatStr(Ret, 28, 3) & LTrim(Mid(NewText(J), ID)) & vbNewLine
                      Exit For
                  End If      
                End If
            ' End If
          Next
   I = I + 1
Loop
fich2.Close
 
' Pour tester, il vaut mieux créer un autre fichier de sortie pour 
' ne pas avoir à modifier(restaurer) le fichier Resultat.txt
    Set fich2 = fso.OpenTextFile("Resultat1.txt", ForWriting, True) 
    Fich2.Write Result
    fich2.Close
    Dim WS : Set Ws = CreateObject("Wscript.Shell")
    WS.PopUp "Opération terminée avec succès" , 1, fso.GetBaseName(Wscript.ScriptName), 64
' La paresse peut parfois être utile: j'ai horreur de 
' lancer puis fermer un fichier à plusieurs reprises
 
Ws.Run "Resultat1.txt", 1 , true
'=======================
Function FormatStr(strIn, TotalLen, NumSpc)
    ' TotalLen : Longueur de la chaine strIn à traiter + le nombre d'espaces à lui ajouter
    ' NumSpc : nombre d'espaces à ajouter
    Dim L ' Longueur de la chaine
    L = Len(strIn)
    If TotalLen <= L Then TotalLen = L + 2 
    If NumSpc < TotalLen - L + 1  Then NumSpc = TotalLen - L - 1
    FormatStr = strIn & String(NumSpc , Chr(32))
End Function