.vbs Aidez-moi à boucler ceci à travers un répertoire

Question

J'ai écrit un script qui fonctionne. Qu'est-ce qu'il fait maintenant, il regarde à travers un répertoire à un fichier donné et retourne ce qui est sur la quatrième rangée quatrième onglet (RXC193) et renomme le fichier à celui qu'il a trouvé dans un fichier comme ceci:

@Program @ RxBIN @RXPCN @RxGroup @MemberID @WebsiteE @WebsiteS @VerticalLogo @TextLogo
RXCUT 013824 RXCUT RXC193 RXC5FHXF9 www.rxcut.com/HBG www.rxcut.com/HBG/es P: \ RxCut \ mise en œuvre de conception \ RXC193

Ce que j'ai besoin de ce script est de faire une boucle dans le répertoire et de renommer tous les fichiers par ce RXC#####. Voici le script:

Call TwoDimensionArrayTest 

Sub TwoDimensionArrayTest 
' Version 1.0 
' Writtem by Krystian Kara 
' Dated 25-Jan-2009 


    Dim fso 
    Dim oFile 
    Dim arrline 
    Dim arrItem 
    Dim objFolder 
    Dim i 
    Dim arrMain() 
    Dim sFileLocation, strResults 

    Const forReading = 1 

' The file contains on each line: 
    ' Text1 (tab) Text2 (tab) Text3 (tab) Text4 
    ' Text5 (tab) Text6 (tab) Text7 (tab) Text8 
'etc etc 


    Set fso = CreateObject("Scripting.FileSystemObject") 
     sFileLocation = "file 2.txt" 

     Set oFile = fso.OpenTextFile(sFileLocation, forReading, False) 

    Do While oFile.AtEndOfStream <> True 
     strResults = oFile.ReadAll 
    Loop 

' Close the file 
    oFile.Close 

' Release the object from memory 
    Set oFile = Nothing 

' Return the contents of the file if not Empty 
    If Trim(strResults) <> "" Then 

     ' Create an Array of the Text File 
     arrline = Split(strResults, vbNewLine) 
    End If 

    For i = 0 To UBound(arrline) 
     If arrline(i) = "" Then 
      ' checks for a blank line at the end of stream 
      Exit For 
     End If 

     ReDim Preserve arrMain(i) 

      arrMain(i) = Split(arrline(i), vbTab) 

    Next 

    fso.MoveFile "file 2.txt", arrMain(1)(3) & ".txt" 

End Sub ' TwoDimensionArrayTest 

Merci à l'avance, Joe

Answer 1

Une approche consiste à paramétrer le nom du fichier dans votre sous-procédure de sorte qu'il peut être appelé plusieurs fois pour des fichiers différents, comme ceci:

Sub TwoDimensionArrayTest(fileName) 'you may want a more descriptive name 

    ' ... 
    sFileLocation = fileName 
    ' ... 

End Sub 

Ensuite, écrire une boucle qui passe par votre répertoire, appeler votre sous chaque fois:

Dim fso, folder 

Set fso = CreateObject("Scripting.FileSystemObject") 
Set folder = fso.GetFolder("Your Folder Name") 
For Each file In folder.Files 
    TwoDimensionArrayTest file.Path 
Next 

Answer 2

Voici le code gratuit Final Error! Enfin, faites une recherche dans mon répertoire de fichiers délimités par tabulation.txt et saisissez à partir de la deuxième rangée le troisième onglet (numéro de groupe) puis renommez les fichiers en leur nombre de groupe correspondant! YAY!

erreur finale Heres code libre !:

Call TwoDimensionArrayTest 

Sub TwoDimensionArrayTest

Dim fso Dim oFile Dim arrline Dim arrItem Dim i Dim arrMain() Dim sFileLocation, strResults

Const forReading = 1 

strFolder = "C: \ Documents et paramètres \ jmituzas.NMCLLC \ Desktop \ desktop2 \ Nouveau dossier (2) \ datafiles" Définissez objFSO = CreateObject ("Scripting.FileSystemObject") Pour chaque objFile dans objFSO.GetFolder (strFolder) .files Si droit (LCase (objFile.Name), 4) = LCase ("txt") Puis

' The file contains on each line: 
' Text1 (tab) Text2 (tab) Text3 (tab) Text4 
' Text5 (tab) Text6 (tab) Text7 (tab) Text8 

« etc etc

Set fso = CreateObject ("Scripting.FileSystemObject") sFileLocation = objFile.Nommez

Set oFile = fso.OpenTextFile(objFile.Name, forReading, False) 

Do While oFile.AtEndOfStream <> True 
    strResults = oFile.ReadAll 
Loop 

' Close the file 
oFile.Close 

'Libérer l'objet de la mémoire Set oFile = Nothing

' Retourne le contenu du fichier sinon vide Si TRIM (strResults) <> "" Puis

' Create an Array of the Text File 
    arrline = Split(strResults, vbNewLine) 
End If 

For i = 0 To UBound(arrline) 
    If arrline(i) = "" Then 
     ' checks for a blank line at the end of stream 
     Exit For 
    End If 

    ReDim Preserve arrMain(i) 

     arrMain(i) = Split(arrline(i), vbTab) 

Next 

    fso.MoveFile sFileLocation, arrMain(1)(3) & ".txt" 

Fin Si Suivant End Sub 'TwoDimensionArrayTest