stevenhab
Messages postés31Date d'inscriptionmercredi 3 octobre 2007StatutMembreDernière intervention 5 mars 2008
-
22 févr. 2008 à 16:33
stevenhab
Messages postés31Date d'inscriptionmercredi 3 octobre 2007StatutMembreDernière intervention 5 mars 2008
-
27 févr. 2008 à 10:37
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
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
stevenhab
Messages postés31Date d'inscriptionmercredi 3 octobre 2007StatutMembreDernière intervention 5 mars 2008 25 févr. 2008 à 17:31
merci, et pour mes fichier ? là on copie les Ouvrage_id.pdf mais pas les couv_id.pdf et la copy est sensbile a la casse, voici le code avec ttes nos modifs.
Option Explicit
Const ForReading = 1
Dim objFso, objDicoID, objDicoFiles
Dim strPath, strFile, strFicTxt, strPathDest
Dim strResult, i, j, k
ReDim arrFiles(0)
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
'----------
Dim strList
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)
objFso.CopyFile strResult(k), strPathDest & "" & Mid(strResult(k), InstrRev(strResult(k), "") + 1)
strList = strList &vbcr& strPathDest & "" & Mid(strResult(k), InstrRev(strResult(k), "") + 1)
Next
End If
Next
Set objFso = Nothing
Set objDicoID = Nothing
Set objDicoFiles = Nothing
MsgBox strList,,"Fichiers disponibles"
'=========================
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
If Right(objFile.Name,4) = ".pdf" Then
Set objDicoFiles(objFile.Path) = objFile
End If
End if
Next
For Each subFolder In argFolder.SubFolders
Call CreateFilesList(subFolder)
Next
End Sub
cs_JMO
Messages postés1854Date d'inscriptionjeudi 23 mai 2002StatutMembreDernière intervention24 juin 201827 26 févr. 2008 à 13:08
Bonjour à tous,
Bonjour stevenhab,
Pour selectionner les couvertures et les ouvrages, et en même temps, résoudre le problème de casse:
Sub CreateFilesList(argFolder)
Dim objFile, subFolder
For Each objFile In argFolder.Files
If LCase(Left(objFile.Name,8)) = "ouvrage_" Or_
LCase(Left(objFile.Name,5) = "couv_" Then
Set objDicoFiles(objFile.Path) = objFile
End if
Next
For Each subFolder In argFolder.SubFolders
Call CreateFilesList(subFolder)
Next
End Sub
La fonction LCase renvoie une chaîne qui a été convertie en minuscules.
La fonction UCase renvoie une chaîne qui a été convertie en majuscules.
stevenhab
Messages postés31Date d'inscriptionmercredi 3 octobre 2007StatutMembreDernière intervention 5 mars 2008 26 févr. 2008 à 17:15
c'est bon j'ai reussi en faite :
Sub CreateFilesList(argFolder)
Dim objFile, subFolder
For Each objFile In argFolder.Files If LCase(Left(objFile.Name,8)) "ouvrage_" Or LCase(Left(objFile.Name,5) "couv_" ) Then
If Right(objFile.Name,4) = ".pdf" Then
Set objDicoFiles(objFile.Path) = objFile
End if
End if
Next
For Each subFolder In argFolder.SubFolders
Call CreateFilesList(subFolder)
Next
End Sub
par contre je me suis rendu compte que j'avais des .pdf et des .PDF :(
stevenhab
Messages postés31Date d'inscriptionmercredi 3 octobre 2007StatutMembreDernière intervention 5 mars 2008 26 févr. 2008 à 17:25
c'est bon aussi , la casse ne fonctionne pas sur couv_ , je ne comprend pas :s
'= ========================
Sub CreateFilesList(argFolder)
Dim objFile, subFolder
For Each objFile In argFolder.Files If LCase(Left(objFile.Name,8)) "ouvrage_" Or LCase(Left(objFile.Name,5) "couv_" ) Then If LCase(Right(objFile.Name,4)) ".pdf" Or LCase(Right(objFile.Name,4)) ".PDF"Then
Set objDicoFiles(objFile.Path) = objFile
End if
End if
Next
For Each subFolder In argFolder.SubFolders
Call CreateFilesList(subFolder)
Next
End Sub
cs_JMO
Messages postés1854Date d'inscriptionjeudi 23 mai 2002StatutMembreDernière intervention24 juin 201827 26 févr. 2008 à 17:56
Re,
For Each objFile In argFolder.Files
If (LCase(Left(objFile.Name,8)) = "ouvrage_" Or _
LCase(Left(objFile.Name,5)) = "couv_") And _
UCase(objFso.GetExtensionName(objFile.Path)) = "PDF" Then
Set objDicoFiles(objFile.Path) = objFile
End if
Next
Qu'entends-tu par ouvrages et couvertures non copiés ?
- extension <> de pdf;
- ouvrage_id ou couv_id non positionné en début du nom de fichier;
- id <= 6000;
- autres cas.
stevenhab
Messages postés31Date d'inscriptionmercredi 3 octobre 2007StatutMembreDernière intervention 5 mars 2008 26 févr. 2008 à 18:11
re, quel difference entre or_ et or ?
!!! mon chef vient de me dire à l'instant qu'il ne faut pas tester sur >6000 mais sur autre chose, comme tu la surement compris on parcours les dossiers et on y extrait couv et ouvrage, mais il faudrait faire la copie seulement si dans le dossier on y trouvre un fichier "dossier_policeok" qui indique que l'ouvrage est correct (en fonction de la police).
et pour les erreur, il faudrait afficher si :
-fichier absent ou mal ecrit
-fichier policeok absent