Recherche de fichier et copie en VBSRésolu

Question

Bonjour à tous et à toutes !

J'ai vraiment besoin de votre aide. :??: 

Je m'explique, je cherche a écrire un script qui à l'aide d'un liste d'id (dans un fichier .txt , ex : 10456,12588...) va rechercher un fichier .doc contenant cet id, ce fichier existe mais il se trouve dans un dossier parmi 4 autres (ce qui nous fais plusieurs sous dossiers).

L'idée serait de dire, pour chaque id du fichier aller chercher le fichier correspondant et le copier/coller ailleurs.
Il faudrait également lui dire dans quel fichier racine chercher.

Si quelqu'un sait comment faire  :sweat:

voici quelque precision, je ne m'en sort pas, mon patron me met la pression alors que je ne suis qu'un petit stagiaire :s HELP PLEASE !

Voici ma liste d'id, je ne traite que les id > 6000 : 
1015
1165
9019
9032
9202
6831
6060
6831

et je cherche dans cette architechture, là commence les pbs :s
+---Txt courants
¦   +---01_MC Originaux
¦   ¦   +---MC 1000-1999
¦   ¦   ¦   +---ouvrages_2001-2005
¦   ¦   +---MC 9000-9999
¦   ¦       +---Mc_9159
¦   ¦       +---MC_9202
¦   +---02_MC En cours
¦   +---03_MC Traités
¦       +---MC 2000-2999
¦       ¦   +---MC_2888
¦       ¦   ¦   +---archives
¦       ¦   +---MC_2891
¦       +---MC 6000-6999
¦           +---MC_6689
¦           +---MC_6831
¦               +---ouvrage_6831 ancienne version
+---Txt Institutions
¦   +---01_MI Originaux
¦   ¦   +---MI 10000-10999
¦   ¦       +---MI_10789
¦   +---02_MI En cours
¦   +---03_MI Traités
¦       +---MI 10001-10099
¦       ¦   +---MI_10789
¦       ¦   ¦   +---PDf_divers
¦       ¦   +---MI_10848
¦       ¦       +---Archives
¦       +---MI 4000-4999
¦           +---Mi_4445
¦           ¦   +---Couv_4445
¦           +---MI_4713
+---Txt ONG-Associations
¦   +---01_MO Originaux
¦   ¦   +---MO 0-999
¦   ¦   +---MO 1000-1999
¦   ¦   +---MO 10000-10999
¦   ¦   ¦   +---MO_10776
¦   ¦   +---MO 11000-11999
¦   ¦   +---MO 2000-2999
¦   ¦   +---MO 3000-3999
¦   ¦   ¦   +---ISBN-MU ID
¦   ¦   +---MO 4000-4999
¦   ¦   +---MO 5000-5999
¦   ¦   +---MO 6000-6999
¦   ¦   +---MO 7000-7999
¦   +---02_MO En cours
¦   ¦   +---MO 0-999
¦   ¦   ¦   +---MO_ID
¦   ¦   +---MO 1000-1999
¦   ¦   +---MO 10000-
¦   ¦   +---MO 11000-11999
¦   ¦   +---MO 2000-2999
¦   ¦   +---MO 3000-3999
¦   ¦   ¦   +---ISBN-MU ID
¦   ¦   +---MO 4000-4999
¦   ¦   +---MO 5000-5999
¦   ¦   +---MO 6000-6999
¦   ¦   +---MO 7000-7999
¦   ¦   +---MO 9000-9999
¦   +---03_MO Traités
¦       +---MO 10001-10999
¦       ¦   +---MO_10775
¦       ¦   +---MO_10776
¦       +---MO 9000-9999
¦           +---MO_9650
¦               +---archives
+---Txt Universitaires
    +---01_MU Originaux
    ¦   +---MU 5000-5999
    ¦   +---Mu_7883
    +---02_MU En cours
    +---03_MU Traités
        +---MU 8000-8999
            +---MU_8118
            +---MU_8298

voici mon code à ce jour :

On Error Resume next
racine= "C:\Fonction routage"
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

'on instance le fichier texte 
Set Ftxt = FSO.OpenTextFile(racine &amp;"id.txt")
'on instance le dossie racine
Set Afolder=FSO.GetFolder(racine)
'on parcour le fichier texte contenant les ID
Do While Not Ftxt.AtEndOfStream
    id = Ftxt.ReadLine
    WScript.Echo id  
    copie(Afolder)
Loop
Ftxt.Close 'on ferme le fichier texte

function copie(rep)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFiles = rep.Files
    For Each AFile In TheFiles
        'trouve le fichier et le copie ailleur         
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      If id > 6000 Then
          objFSO.CopyFile "MC_" &amp; id &amp; "\Ouvrage_" &amp; id &amp; ".doc" , "C:\Fonction routage	est" 
      Else
          MsgBox "Ouvrage à copier manuellement : " &amp; id , vbExclamation
      End If
      Set objFSO = Nothing
          
        For Each subFolder In rep.SubFolders
            copie(subFolder)
        Next
    Next    
End function 


Merci a vous..

cs_JMO · Accepted Answer

Re,

_   sert,  dans ce cas, de retour à ligne pour la présentation, mais il y a des restrictions.
If (LCase(Left(objFile.Name,8)) "ouvrage_" Or LCase(Left(objFile.Name,5)) "couv_")   And _
           UCase(objFso.GetExtensionName(objFile.Path)) = "PDF" Then

Projet très versatile.
Oui, c'est réalisable. Par tableaux (avec Select Case) et/ou dictionnaires.
Attention, pour l'affichage, vu le nombre d'ID et de fichiers.

jean-marc

cs_JMO · Answer

Bonjour à tous, Bonjour stevenhab, Pour les futures questions en vbs = > Vous êtes ici : [infomsg.aspx Thèmes] / [infomsgf_VISUAL-BASIC_1.aspx Visual Basic 6] / [infomsgt_LANGAGES-DERIVES_287.aspx Langages dérivés] / [infomsgt_VBSCRIPT_245.aspx VBScript] Ci-dessous, un exemple avec l'objet Dictionary . 1) La fonction FnReadFileTxt parcours le fichier ID.txt et écrit, dans le dictionnaire objDicoID, les ID > à 6000; Nota: rajouter éventuellement un objDicoID.Exists(Trim(strline)) pour contrôler les doublons dans le fichier ID.txt 2) La procédure CreateFilesList parcours folder et subfolders et écrit, dans le dictionnaire objDicoFiles, le chemin complet des fichiers .doc; Evidemment, il faut changer le répertoire du CopyFile. Option Explicit Const ForReading = 1 Dim objFso, objDicoID, objDicoFiles Dim strPath, strFile, strFicTxt Dim strResult, i, j ReDim arrFiles(0) strPath = "C:\Fonction routage" strFile = "id.txt" Set objFso = CreateObject("Scripting.FileSystemObject") Set objDicoID = CreateObject("Scripting.Dictionary") Set objDicoFiles = CreateObject("Scripting.Dictionary") ' 'Dictionnaire contenant les ID supérieures à 6000 objDicoID = FnReadFileTxt(objDicoID, strPath & strFile) 'Dictionnaire contenant les fichiers .doc Call CreateFilesList(objFso.GetFolder(strPath)) 'Transformation du dictionnaire des fichiers en tableau Dim elements elements = objDicoFiles.Items For i=0 To objDicoFiles.Count-1 arrFiles(UBound(arrFiles)) = elements(i) ReDim Preserve arrFiles(UBound(arrFiles) + 1) Next Dim list list = "Visu liste des fichiers à copier" &vbcrlf For j=0 To UBound(objDicoID)-1 strResult = Filter(arrFiles, objDicoID(j)) If UBound(strResult) = 0 Then list = list &vbCrLf& strResult(0) 'MsgBox strResult(0),,"Fichier à copier avec objFso.CopyFile" End If Next Set objFso = Nothing Set objDicoID = Nothing Set objDicoFiles = Nothing MsgBox list,,"resultat" '========================= Private Function FnReadFileTxt(objDicoID, argFile) Dim objFile, strLine, cpt_ID 'lecture fichier + création dictionnaire Set objFile = objFso.OpenTextFile(argFile, ForReading) cpt_ID = 0 Do while not objFile.AtEndOfStream strLine = objFile.ReadLine If strLine > 6000 Then objDicoID.Add cpt_ID, Trim(strLine) cpt_ID = cpt_ID + 1 End If Loop objFile.Close Set objFile = Nothing FnReadFileTxt = objDicoID.Items End function '========================= Sub CreateFilesList(argFolder) Dim objFile, subFolder For Each objFile In argFolder.Files If objFso.GetExtensionName(objFile) = "doc" Then Set objDicoFiles(objFile.Path) = objFile End if Next For Each subFolder In argFolder.SubFolders Call CreateFilesList(subFolder) Next End Sub jean-marc

stevenhab · Answer

Salut JMO, un grand merci pour ton aide !!

Les fichiers que je dois copier se noment Ouvrage_id.doc et Ouvrage_id.pdf, dans chaque dossier ce trouve ces deux fichiers.
Je ne vois pas où je dois place ma copie dans ton code? Il ne faut pas que je test sur les .doc mais sur les noms complets..

Merci pr ton aide precieuse.

Steven

cs_JMO · Answer

Bonsoir,

2 petites modifications:

For j=0 To UBound(objDicoID)-1
    'MsgBox Join(arrFiles,vbCr) 
    strResult = Filter(arrFiles, objDicoID(j))
    If UBound(strResult) >= 0 Then
       For k=0 To UBound(strResult) 
           MsgBox strResult(k),,"Fichier à copier avec objFso.CopyFile"
       Next
    End If
Next
 et 
    For Each objFile In argFolder.Files
        If Left(objFile.Name,8) = "Ouvrage_" And _
           (LCase(objFso.GetExtensionName(objFile)) = "doc" Or _
            LCase(objFso.GetExtensionName(objFile)) = "pdf") Then
           Set objDicoFiles(objFile.Path) = objFile
        End if
    Next

jean-marc

stevenhab · Answer

salut :) et merci encore, on teste pas le nom du fichier la, jsute l'extension :s

tu peux me faire un c/c avec tes 2 modifs placée au bon endroit ?

steven

cs_JMO · Answer

Re,

voir même

    For Each objFile In argFolder.Files
        If Left(objFile.Name,8) = "Ouvrage_" Then
           Set objDicoFiles(objFile.Path) = objFile
        End if
    Next
ou
    For Each objFile In argFolder.Files 
        If InStr(1,objFile.Name,"Ouvrage_") = 0 Then

           Set objDicoFiles(objFile.Path) = objFile

        End if

    Next

jean-marc

stevenhab · Answer

mon ouvrage il s'appelle : Ouvrage_10566.doc et Ouvrage_10566.pdf

cs_JMO · Answer

Re,

Le script n'a pas changé!

Option Explicit
Const ForReading = 1
Dim objFso, objDicoID, objDicoFiles
Dim strPath, strFile, strFicTxt
Dim strResult,  i, j, k
ReDim arrFiles(0)

strPath = "C:\Fonction routage"
strFile = "id.txt"

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objDicoID = CreateObject("Scripting.Dictionary")
Set objDicoFiles = CreateObject("Scripting.Dictionary")
'
'Dictionnaire contenant les ID supérieures à 6000
objDicoID = FnReadFileTxt(objDicoID, strPath & strFile)

'Dictionnaire contenant les fichiers contenant 
'"Ouvrage_" dans le nom"
Call CreateFilesList(objFso.GetFolder(strPath))

'Transformation du dictionnaire des fichiers en tableau 
Dim elements
elements = objDicoFiles.Items 
For i=0 To objDicoFiles.Count-1
    arrFiles(UBound(arrFiles)) = elements(i)  
    ReDim Preserve arrFiles(UBound(arrFiles) + 1)
Next

For j=0 To UBound(objDicoID)-1
    'MsgBox Join(arrFiles,vbCr) 
    strResult = Filter(arrFiles, objDicoID(j))
    If UBound(strResult) >= 0 Then
       For k=0 To UBound(strResult) 
           MsgBox strResult(k),,"Fichier à copier avec objFso.CopyFile"
       Next
    End If
Next

Set objFso = Nothing
Set objDicoID = Nothing
Set objDicoFiles = Nothing

'=========================
Private Function FnReadFileTxt(objDicoID, argFile)
   Dim objFile, strLine, cpt_ID
   'lecture fichier + création dictionnaire
   Set objFile = objFso.OpenTextFile(argFile, ForReading)
   cpt_ID = 0

   Do while not objFile.AtEndOfStream
      strLine = objFile.ReadLine
      If strLine > 6000 Then
         objDicoID.Add cpt_ID, Trim(strLine)
         cpt_ID = cpt_ID + 1
      End If
   Loop
   objFile.Close
   Set objFile = Nothing
   FnReadFileTxt = objDicoID.Items                    
End function
'=========================
Sub CreateFilesList(argFolder)
    Dim objFile, subFolder
    For Each objFile In argFolder.Files
        If Left(objFile.Name,8) = "Ouvrage_" Then
           Set objDicoFiles(objFile.Path) = objFile
        End if
    Next
    For Each subFolder In argFolder.SubFolders
        Call CreateFilesList(subFolder)
    Next
End Sub

jean-marc

stevenhab · Answer

'= ========================
Sub CreateFilesList(argFolder)
    Dim objFile, subFolder
    For Each objFile In argFolder.Files
        If Left(objFile.Name,8) =  "Ouvrage_"  Then
           Set objDicoFiles(objFile.Path)  = objFile
        End if
    Next
    For Each subFolder In argFolder.SubFolders
        Call CreateFilesList(subFolder)
    Next
End Sub

tu tests sur Ouvrage_ , mais il faudrait mettre l'id en plus nan?

cs_JMO · Answer

Re,

L'ID > 6000 est bien testée dans la fonction FnReadFileTxt. 
La variable strLine contient cette id, puis, elle est stockée (en enlevant les éventuels espaces) dans le dictionnaire objDicoID.
Quant à la procédure CreateFilesList, elle permet, via le dictionnaire objDicoFiles, de ne parcourir qu'une seule fois 
l'arborescence de tes répertoires.  

      If strLine > 6000 Then
         objDicoID.Add cpt_ID, Trim(strLine)
         cpt_ID = cpt_ID + 1
      End If

jean-marc

stevenhab · Answer

ah oki merci , il se copie mes fichiers ?

aprés je ne t'embete plus promis :)

stevenhab · Answer

il se copie où mes fichiers ?

stevenhab · Answer

c'est bon j'ai trouvé :)

ton scripte est super ! t'es un tueur en VBS !!

merci a toi et surtout je n'hesite pas a te recontacter si besoin

cs_JMO · Answer

Bonjour à tous,

Bonjour stevenhab,

Mon environment de test est sur mon disk externe, qui est au boulot !

Dans la boucle
For j=0 To UBound(objDicoID)-1
    strResult = Filter(arrFiles, objDicoID(j))
    If UBound(strResult) >= 0 Then
       For k=0 To UBound(strResult)
           'MsgBox strResult(k),,"Fichier à copier avec objFso.CopyFile"
           objFso.CopyFile strResult(k), "destination"
       Next
    End If
Next

il faudra parser la variable  strResult(k)  pour ne garder  que le nom du  fichier.
Je regarde celà ce soir.
Quel sera le répertoire de destination ????
Attention:
Ce répertoire doit être différent de l'arborescence "C:\Fonction routage".

jean-marc

cs_JMO · Answer

Re,

Merci de clore ce post en validant la réponse qui a solutionné ton problème.

jean-marc

stevenhab · Answer

je dois copier les Ouvrage_id.pdf et couv_id.pdf en essayant de ne pas tenir compte de la casse car il peut arriver que les majuscules ne soient pas réspectées.

dans le cas où un fichier n'a pas été copié, pourrait-on en avertir la personne qui lance le scripte pour qu'elle verifie soit l'existance du fichier ou autre..

cordialement 
steven

stevenhab · Answer

le rep de destination est en faite sur un serveur locale:
\Mansrv01\atome\Fabrication\fab-Commandes\cdes Augustin\Commande 2008

cs_JMO · Answer

Re,

Dim strPathDest
strPathDest = "\Mansrv01\atome\Fabrication\fab-Commandes\cdes Augustin\Commande 2008"
objFso.CopyFile strResult(k), strPathDest & "" & "nom du fichier"

Sauf erreur de part, le copyfile ignore la casse.

jean-marc

stevenhab · Answer

nikel, peut on rajouter une msg box pour avertir de la fin du traitement?

stevenhab · Answer

salut :) désolé pour ces changements, on laisse tomber dossier_policeok !

je tiens à te remercier pour ton aide, tu n'as pas sauvé le monde mais tu m'as sauvé la vie ! lol.

Bonne continuation pour la suite , et encore merci, vraiment.

Steven

Ps: t'es un killer en vbs

Recherche de fichier et copie en VBS

34 réponses

Votre réponse

Discussions similaires