Recherche de fichier et copie en VBS

[Résolu]
Signaler
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008
-
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008
-
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 &"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_" & id & "\Ouvrage_" & id & ".doc" , "C:\Fonction routage\test" 
      Else
          MsgBox "Ouvrage à copier manuellement : " & id , vbExclamation
      End If
      Set objFSO = Nothing
          
        For Each subFolder In rep.SubFolders
            copie(subFolder)
        Next
    Next    
End function 


Merci a vous..

34 réponses

Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
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
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

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
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 

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)  <st1:personname productid ="La fonction FnReadFileTxt" w:st= "on">La
fonction FnReadFileTxt</st1:personname>
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)  <st1:personname productid ="La proc?dure CreateFilesList" w:st="on">La
procédure CreateFilesList</st1:personname> 
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
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

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
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 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
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

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
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
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
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

mon ouvrage il s'appelle : Ouvrage_10566.doc et Ouvrage_10566.pdf
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
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
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

'= ========================
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?
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
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
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

ah oki merci , il se copie mes fichiers ?

aprés je ne t'embete plus promis :)
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

il se copie où mes fichiers ?
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

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
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 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
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Re,

Merci de clore ce post en validant la réponse qui a solutionné ton problème.

jean-marc
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

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
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

le rep de destination est en faite sur un serveur locale:
\\Mansrv01\atome\Fabrication\fab-Commandes\cdes Augustin\Commande 2008
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
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
Messages postés
31
Date d'inscription
mercredi 3 octobre 2007
Statut
Membre
Dernière intervention
5 mars 2008

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