Exemples de procédures vbscript

Soyez le premier à donner votre avis sur cette source.

Vue 72 046 fois - Téléchargée 2 311 fois

Télécharger le projet
Commenter

Description

Je mets ces sources à disposition pour démontrer que l'on peut écrire utilement des procs en VBScript. Ce langage ne sert pas seulement à "faire" des virus.
N'ayant pas VB, je me suis initié au VBS. Donc, ces codes peuvent être surement améliorés.
Ces sources démontrent le maniement de répertoires, fichiers, dates ... via fso et shell.

Source / Exemple : 


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Récupération du mois précédent sur 2 caractères (01 à 12)  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Dim wDate
Dim wMM
Dim wAAAAMM
wDate = Dateadd("m", -1, Date())
wMM = Month(wDate)
If Len(wMM) = 1 Then
   wMM = "0" & wMM
End If
wAAAAMM = CStr(Year(wDate)) & "-" & wMM

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Répertoires source, archive (local) et destination  '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim wRepSrce1
Dim wRepSrce2
Dim wRepSrce3
Dim wRepDest1
Dim wRepDest2
Dim wRepDest3
wRepSrce1 = "c:\CSSI\Ales\"
wRepSrce2 = "c:\CSSI\Bour\"
wRepSrce3 = "c:\CSSI\Pneu\"
wRepDest1 = "c:\Archive-Ales\" & wAAAAMM & "\"
wRepDest2 = "c:\Archive-Bour\" & wAAAAMM & "\"
wRepDest3 = "c:\Archive-Pneu\" & wAAAAMM & "\"
wSrce1 = "c:\CSSI\Ales\*.txt"
wSrce2 = "c:\CSSI\Bour\*.txt"
wSrce3 = "c:\CSSI\Pneu\*.txt"
Var Reponse

Set fso = CreateObject("Scripting.FileSystemObject")
Reponse = MsgBox ("Traitement CAE CROUZET.   Nous sommes le "&Date&" et vous allez archiver les fichiers mensuels de la période "&wAAAAMM&"",vbInformation+vbYESNo)

If Reponse = vbNo Then 
   MsgBox ("Vous avez répondu NON - Arrêt du traitement !!!")
   WScript.Quit
Else
   Reponse = vbYES 
'  MsgBox ("Vous avez répondu OUI - Suite du traitement !!!")   
End  if

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Répertoires ALES				       '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not fso.FolderExists(wRepDest1) Then
   Set f = fso.CreateFolder(wRepDest1)
       msgBox "Création du dossier "&f&" effectuée.",vbInformation
       fso.MoveFile wSrce1, wRepDest1
   Else
       msgBox "Attention:"&vbCrLf&"Le répertoire "&wRepDest1&" existe déjà."&vbCrLf&"Les nouveaux fichiers ne sont donc pas archivés",vbCritical
End if
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Répertoires BOUR				       '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not fso.FolderExists(wRepDest2) Then
   Set f = fso.CreateFolder(wRepDest2)
       msgBox "Création du dossier "&f&" effectuée.",vbInformation
       fso.MoveFile wSrce2, wRepDest2
   Else
       msgBox "Attention:"&vbCrLf&"Le répertoire "&wRepDest2&" existe déjà."&vbCrLf&"Les nouveaux fichiers ne sont donc pas archivés",vbCritical
End if
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Répertoires PNEU				       '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not fso.FolderExists(wRepDest3) Then
   Set f = fso.CreateFolder(wRepDest3)
       msgBox "Création du dossier "&f&" effectuée.",vbInformation
       fso.MoveFile wSrce3, wRepDest3 
   Else
       msgBox "Attention:"&vbCrLf&"Le répertoire "&wRepDest3&" existe déjà."&vbCrLf&"Les nouveaux fichiers ne sont donc pas archivés",vbCritical
End if

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Vérification ALES				       '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Path
Path = wRepDest1
Path1 = wRepSrce1
MsgBox ShowFolderList(Path),vbmessage,"Vérification de l'archivage des fichiers => répertoire " & Path

Function ShowFolderList(strPath)
Dim fso, Dossiers, fic, fichiers, strListe
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(strPath)
Set fic = Dossiers.Files
For Each fichiers in fic
'le nom du fichier
strListe = strListe & vbcrlf & vbcrlf & fichiers.Name & "    Date (jjmmaa) : " & fichiers.DateLastModified & "    Taille (octet) : " & fichiers.Size
Next
ShowFolderList = strListe & vbcrlf & vbcrlf & vbcrlf & " Le répertoire   " & Path1 & "   a été purgé de ses fichiers"
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Vérification BOUR				       '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Path = wRepDest2
Path1 = wRepSrce2
MsgBox ShowFolderList(Path),vbmessage,"Vérification de l'archivage des fichiers => répertoire " & Path

Function ShowFolderList(strPath)
Dim fso, Dossiers, fic, fichiers, strListe
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(strPath)
Set fic = Dossiers.Files
For Each fichiers in fic
'le nom du fichier
strListe = strListe & vbcrlf & vbcrlf & fichiers.Name & "    Date (jjmmaa) : " & fichiers.DateLastModified & "    Taille (octet) : " & fichiers.Size
Next
ShowFolderList = strListe & vbcrlf & vbcrlf & vbcrlf & " Le répertoire   " & Path1 & "   a été purgé de ses fichiers"
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Vérification PNEU				       '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Path = wRepDest3
Path1 = wRepSrce3
MsgBox ShowFolderList(Path),vbmessage,"Vérification de l'archivage des fichiers => répertoire " & Path

Function ShowFolderList(strPath)
Dim fso, Dossiers, fic, fichiers, strListe
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(strPath)
Set fic = Dossiers.Files
For Each fichiers in fic
'le nom du fichier
strListe = strListe & vbcrlf & vbcrlf & fichiers.Name & "    Date (jjmmaa) : " & fichiers.DateLastModified & "    Taille (octet) : " & fichiers.Size
Next
ShowFolderList = strListe & vbcrlf & vbcrlf & vbcrlf & " Le répertoire   " & Path1 & "   a été purgé de ses fichiers"
End Function

Set fso = Nothing

Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
xDate = InputBox("Saisir la date de retraite sous la forme jj/mm/aaaa","    Décompte Retraite !!!!","30/06/2006")
'xDate = "30/06/2006"          
j1 = DatePart("w", xDate)
j2 = Array("","Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi")
jj = j2(j1)
m1 = DatePart("m", xDate)
m2 = Array("","janvier","février","mars","avril","mai","juin","juillet","août","septembre","octobre","novembre","décembre")
mm = m2(m1)
Result = WshShell.Popup("Votre départ à la retraite étant prévu le      " & jj & " " & Left(xDate,2) & " " & mm & " " & Right(xDate,4) & "       "  & vbcrlf & vbcrlf & "Il ne vous reste plus que ........" & vbcrlf & vbcrlf & "        " & DateDiff("d", Now, xDate) & "   jours  ........ avant de partir à la pêche !!!!!", 30, "Décompte de la retraite")

Dim Fso, path, fichier, fichiers, WshShell
path = "E:\Affaires\EUROFACTOR - AP02N008\4.3 Formulaires\Formulaires spécifiques\"

Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(path)
Set fichiers = Dossier.Files

For Each fichier in fichiers
'MsgBox "shortPath=" & fichier.ShortPath & vbCrLf & "Path=" & fichier.Path
'MsgBox "shortName=" & fichier.ShortName & vbCrLf & "Name=" & fichier.Name
   If Left(fichier.name,19) = "Main courante Ifdex" Then
      WshShell.Run fichier.ShortPath
      WScript.Sleep(3000)
      WshShell.SendKeys "^p"
      WScript.Sleep(2000)
      WshShell.SendKeys "{ENTER}"  'imprimer => ok
      WScript.Sleep(3000)
      WshShell.SendKeys "%(fq)"   'fermeture du document
      WScript.Sleep(3000)
   End If
If Left(fichier.name,6) = "SLIFAC" Then
   WshShell.Run fichier.ShortPath
   WScript.Sleep(2000)
    If Left(fichier.name,22) = "SLIFAC 32 - 61 Espagne" Then
        WshShell.SendKeys "^p"
        WScript.Sleep(2000)
        WshShell.SendKeys "{ENTER}" 'imprimer => ok
        WScript.Sleep(3000)
        WshShell.SendKeys "{ENTER}" 'poursuivre l'impression => ok
        WScript.Sleep(3000)
        WshShell.SendKeys "%(fq)"   'fermeture du document
        WScript.Sleep(3000)
     Else 'section pour éditer <54 EUROFACTOR> , <62 PORTUGAL>
          '                    <67 HOLLANDE>   , <68 READING>
        WshShell.SendKeys "^p"
        WScript.Sleep(2000)
        WshShell.SendKeys "{ENTER}"  'imprimer => ok
        WScript.Sleep(3000)
        WshShell.SendKeys "%(fq)"   'fermeture du document
        WScript.Sleep(3000)
    End If
End If
Next

' Script EuroFactor_Delete Files Rapports-JUPITER.vbs
'
' Suppression des fichiers de la veille
' dans c:\Rapports-JUPITER
' Cette procédure est associée au Planificateur de tâches

Dim jour, jour1, jour2
Dim fso, wSrce
Dim dossier, fichier, fichiers
Dim WshShell, strList, verif

wSrce = "c:\Rapports-JUPITER\"

'''
''' Création des variables de dates
'''
jour   = DatePart("w", Date)
jour1 = Array("Samedi","Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi")
jour2 = jour1(jour)

'''
''' Delete des fichiers en fonction du jour
'''
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(wSrce)
Set fichiers = Dossier.Files
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "C:\WINDOWS\EXPLORER.EXE /n,/e," & wSrce
WScript.Sleep(1000)

For Each fichier in fichiers
     Select Case jour2
     Case "Lundi"
     IF Left(fichier.name,5) = "Vendr" Then
     strList = strList & vbcrlf & fichier     
     fso.DeleteFile(fichier) 
     End If
     Case "Mardi"
     IF Left(fichier.name,5) = "Lundi" Then
     strList = strList & vbcrlf & fichier     
     fso.DeleteFile(fichier) 
     End If
     Case "Mercredi"
     IF Left(fichier.name,5) = "Mardi" Then
     strList = strList & vbcrlf & fichier     
     fso.DeleteFile(fichier) 
     End If
     Case "Jeudi"
     IF Left(fichier.name,5) = "Mercr" Then
     strList = strList & vbcrlf & fichier     
     fso.DeleteFile(fichier) 
     End If
     Case "Vendredi"
     IF Left(fichier.name,5) = "Jeudi" Then
     strList = strList & vbcrlf & fichier     
     fso.DeleteFile(fichier) 
     End If
     End Select
Next
WScript.Sleep(1000)
WshShell.SendKeys "%{F4}",true
WshShell.Run "C:\WINDOWS\EXPLORER.EXE /n,/e," & wSrce
WScript.Sleep(2000)
WshShell.SendKeys "%{F4}",true
Verif = WshShell.Popup(strList & vbcrlf & vbcrlf , 5, "Fichiers supprimés du répertoire : " & wSrce)

' Script EuroFactor_Rapports-JUPITER.vbs
'
' Création des fichiers à partir du répertoire
' e:\Modèles\ vers le répertoire "c:\Rapports-JUPITER
' Les fichiers créés sont préfixés par "jour jj_mm_aaaa_"
' Cette procédure est associée au Planificateur de tâches

Dim jour, jour1, jour2, aa, mm, jjmmaa
Dim fso, f, wSrce, wDest
Dim dossier, fichier, fichiers, newname, Path, strListe
Dim WshShell, Verif

wSrce = "e:\Modèles\"
wDest = "c:\Rapports-JUPITER\"

'''
''' Création des variables de dates
'''
jour   = DatePart("w", Date)
jour1 = Array("Samedi","Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi")
jour2 = jour1(jour)
aa     = DatePart("yyyy", Date) 
mm     = month(now)
If Len(mm) = 1 Then
   mm = "0" & mm
End If
jjmmaa = jour2 & " " & Left(Date,2) & "_" & mm & "_" & aa

'''
''' Copy des fichiers de Modèles vers c:\Rapports-JUPITER
'''
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(wSrce)
Set fichiers = Dossier.files

If Not fso.FolderExists(wDest) Then
   Set f = fso.CreateFolder(wDest)
End if

Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "C:\WINDOWS\EXPLORER.EXE /n,/e," & wDest
 

For Each fichier in fichiers
   If fichier.name = "Main courante Eurofactor Modèle.xls" Then
      Newname = jjmmaa & "   " & fichier.name  
      nbre = nbre + 1
      strListe = strListe & vbcrlf & Newname
      fso.CopyFile fichier, wDest & Newname
   ElseIf fichier.name = "Traitement soir Jupiter.doc" Then
      Newname = jjmmaa & "   " & fichier.name  
      nbre = nbre + 1
      strListe = strListe & vbcrlf & Newname
      fso.CopyFile fichier, wDest & Newname
   Else
   End If
Next

WshShell.SendKeys "%{F4}",true

Verif = WshShell.Popup(strListe & vbcrlf & vbcrlf & "Nombre de fichiers: " & nbre, 20, "Vérification du répertoire : " & wDest)

Dim Path
Path = InputBox("Saisir le répertoire souhaité:                            exemple:  c:\Mes Documents\","Liste de fichier dans un répertoire") 

MsgBox ShowFolderList(Path),vbmessage,"Fichiers contenus dans le  répertoire " & Path

Function ShowFolderList(strPath)

Dim fso, Dossiers, fic, fichiers, strListe

Set fso = CreateObject("Scripting.FileSystemObject")
 
Set Dossiers = fso.GetFolder(strPath)

Set fic = Dossiers.Files

'pour chaque fichier de mon objet files de mon objet fso...:)

For Each fichiers in fic
'le nom du fichier

strListe = strListe & vbcrlf & vbcrlf & fichiers.Name & "    Date (jjmmaa) : " & fichiers.DateLastModified & "    Taille (octet) : " & fichiers.Size
Next

ShowFolderList = strListe 
End Function

' 
' code pour mettre la date du jour jj/mm/aaaa
' sous la forme jj_mm_aa
'
Dim  mm
mm = month(now)
IF Len(mm) = 1 Then
   mm = "0" & mm
End If
MsgBox "jjmmaa = " & Date & " = " & Left(Date,2) & "_" & mm & "_" & Right(Date,2)
'
'================================================
'
' code pour mettre la date du jour jj/mm/aaaa
' sous la forme jj-5/mm/aaaa
'
MsgBox "jj-5/mm/aaaa = " & DateAdd("d", -5, Date)
'
'================================================
'
' code pour mettre la date du jour jj/mm/aaaa
' sous la forme aaqqq (quantième sur 3 positions)
'
Dim xDate
' xDate = Date              'pour test date du jour
xDate = "17/10/2002"      'pour test date imposée
'xDate = "31/03/2002"      'pour test  "     "
'xDate = "31/12/2003"      'pour test  "     "
qqq = DatePart("y", xDate)
If qqq < 10 Then
   MsgBox "Si date = 07/02/2002 => aaqqq = " & Right(xDate,2) & "00" & DatePart("y", xDate)
   Else
   If qqq < 100 Then
   MsgBox "Si date = 31/03/2002 => aaqqq = " & Right(xDate,2) & "0" & DatePart("y", xDate)
   Else
   'MsgBox "Si date = 31/12/2003 => aaqqq = " & Right(xDate,2) & DatePart("y", xDate) 
   MsgBox "Si date = jj/mm/aaaa => aaqqq = " & Right(xDate,2) & DatePart("y", xDate)  
   End If
End If

' 
' Script       :  SAUVEGARDE CONTEXT WINGEP.VBS
' Application  :  Automates WINGEP 
' Objet        :  Sauvegarde fichier context Wingep sur diskette
'                 Copie de c:\Wingep\Context\Wingep.ctx sur a:\ 
'                 Vérification que la disquette soit relisable
' Utilisation  :  Planificateur de tâches (ts les jours ouvrés - 16h00)
' Auteur       :  OLLIVIER Jean-Marc
' Date         :  19 septembre 2002                
'
Dim fso, f, Input, Output, Reponse, Verif, Fichier
Fichier = "Wingep.ctx"
Input  = "c:\Wingep\Context\" & Fichier
Output = "a:\"
Verif = "c:\Vérif-Context\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetDrive(Output)
If f.IsReady Then 
   fso.CopyFile Input, Output
Else 
   Reponse = MsgBox ("Sauvegarde Context Wingep" & vbCrlf & vbCrlf & "Disquette non montée sur lecteur " & Output & vbCrlf & vbCrlf & "Insérer une disquette, puis cliquer sur OK pour continuer " & vbCrlf & vbCrlf & " Si abandon, cliquer sur ANNULER",vbQuestion+vbOkCancel)
   If Reponse = vbCancel Then
      WScript.Quit
   Else
      fso.CopyFile Input, Output
   End If
End If

MsgBox ShowFolderList(Output),vbInformation,"Sauvegarde Context Wingep => copie de " & Input & " sur " & Output

Function ShowFolderList(Output)
Dim fso, fic, Dossiers, Fichiers, StrListe
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(Output)
Set fic = Dossiers.Files
For Each Fichiers in fic
'le nom du fichier
StrListe = StrListe & vbCrlf & vbCrlf & Output & fichiers.Name & "    Date : " & fichiers.DateLastModified & "    Taille (octet) : " & Fichiers.Size
Next

'Vérification que la disquette est bien exploitable
'Copie de a:\Wingep.ctx sur c:\Vérif-Context\

If Not fso.FolderExists(Verif) Then
   fso.CreateFolder(Verif)
End If
fso.CopyFile Output & Fichier, Verif
fso.DeleteFolder("c:\Vérif-Context")

ShowFolderList = StrListe & vbCrlf & vbCrlf & vbClrf & vbCrlf & "Le fichier << " & Input & " >> a bien été copié sur " & Output & vbCrlf & vbCrlf & "Un contrôle de la disquette a été effectué" & vbCrlf & vbCrlf &  "Vous pouvez retirer la disquette du lecteur " & Output & " et la ranger dans la valise du client"
End Function
Set fso = Nothing

Dim fso, f, wSrce, wDest, wPath
Dim dossier, fichier, fichiers, newname, Path, strListe
Dim WshShell, Verif
wSrce = "C:\Jollivier\*"
wDest = "p:\Jollivier\"
wPath = "p:\"
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "C:\WINNT\EXPLORER.EXE /n,/e," & wDest
WScript.Sleep(1500)
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(wDest) Then
   fso.DeleteFolder(wDest & "\*"), True
End If
WshShell.SendKeys "%{F4}",true
WScript.Sleep(1500)
WshShell.Run "C:\WINNT\EXPLORER.EXE /n,/e," & wDest
WScript.Sleep(1500)
fso.copyFolder wSrce, wDest, True
WScript.Sleep(5000)
WshShell.SendKeys "%{F4}",true

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Client :  CDF 
' Auteur :  OLLIVIER Jean-Marc (CS SI)
'                
' Détail:
' 1) Tous les jours ouvrés, sur GCOS7, via l'automate WINGEP HBCM,
'    création de x fichiers (CAST-CRESDE-CDF vl=%aaqqqln)
' 2) Transfert des fichiers de GCOS7 vers la station ARNEB, dans 
'    le répertoire d:\KRNSDE\
'    Nom des fichiers : SDE_yyy-aaqqq
' 3) Ce code est planifié dans "Planificateurs de tâches" sur 
'    la station ARNEB. Il a pour but de supprimer les fichiers                 
'    dont la date de modification est antérieure de  5 jours 
'    de la date machine  
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Path
Path  = "c:\KRNSDE\" 
Path1 = "c:\KRNSDE"
' MsgBox ShowFolderList(Path),vbmessage,"Fichiers présents dans le  répertoire"
' Function ShowFolderList(strPath) 
Dim fso, Dossiers, fic, fichiers, strListe, f, fdate, fname, dtDiffFile 
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder("c:\Krnsde")
Set fic = Dossiers.Files
For Each fichiers in fic 
Set f = fso.GetFile(fichiers)
fdate = f.DateLastModified
fname = f.Name
dtDiffFile = DateDiff("d", Now, fdate)
If dtDiffFile <= -5 Then fso.DeleteFile(Path & fname)
'  MsgBox  "Le fichier " & Path & fname & " sera supprimé car créé le " & fdate
'  Else 
'  MsgBox "Le fichier " & Path & fname & " ne sera pas supprimé car créé le " & fdate
'  End If
'  strListe = strListe & vbcrlf & vbcrlf & fname & " " & fdate 
Next
'  ShowFolderList = strListe 
'  End Function

Dim fso, Path, Fichier, strtmp, i, spec, id, etat, error, succes
Dim objTextStream, strListe, Resultat, wshShell, NewFichier
Path    = "e:\tmp\"
Fichier = "TNG-finsession.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")

Do While Not fso.FileExists(Path & Fichier) 
   'MsgBox "attente car le fichier n'existe pas"
   WScript.Sleep(5000)
Loop

Set objTextStream = fso.OpenTextFile(Path & Fichier, 1)
Do while not objTextStream.AtEndOfStream
strtmp = split(objtextstream.readline," ")
For i = 0 to Ubound(strTmp)
'MsgBox strTmp(i)
If Lcase(strTmp(i)) = "spécification" Then
   strListe = strListe & vbcrlf & vbcrlf & "Spécification de sauvegarde   =>       " & strtmp(i+3)
   spec = strtmp(i+3) 
End If

If strTmp(i) = "Id" Then     
   strListe = strListe & vbcrlf & vbcrlf & "Id session                                =>      " & strtmp(i+2)
   id = strtmp(i+2) 
   id = Replace(id, "/", "_")
End If
If strTmp(i) = "Etat:" Then
   strListe = strListe & vbcrlf & vbcrlf & "Etat                                         =>      " & strtmp(i+1)
   etat = strtmp(i+1) 
End If
If strTmp(i) = "Nombre" Then
   If strTmp(i+1) = "d'erreurs:" Then
   strListe = strListe & vbcrlf & vbcrlf & "Nombre d'erreurs                    =>      " & strtmp(i+2)
   error = strtmp(i+2) 
   End If
End If
If strTmp(i) = "Succès:" Then
   strListe = strListe & vbcrlf & vbcrlf & "Succès                                    =>      " & strtmp(i+1)
   succes = strtmp(i+1)   
End If
Next
loop
objTextStream.Close
'WshShell.Run "cawto OMNIBACK : " & spec & " " & id & " etat=" & etat & " nbre-error=" & error & " succes=" & succes
Resultat = WshShell.Popup(strListe & vbcrlf & vbcrlf, 5, "Displays pour OMNIBACK")

NewFichier = spec & " " & id & " " & Fichier
MsgBox "Fichier=" & Fichier & "   NewFichier=" & NewFichier
fso.MoveFile Path & Fichier, Path & NewFichier
Set fso = Nothing

Conclusion :


Premier reproche: je n'ai pas mis beaucoup de commentaires dans mes procs.
Soyez indulgent....merci........jean-marc
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_TheHacker
Messages postés
442
Date d'inscription
samedi 23 novembre 2002
Statut
Membre
Dernière intervention
19 octobre 2005
 -
Tu crois pas que ce serait + simple de mettre un zip au lieu d'ecrire une source que personne lira comme ca ?!
Signaler
cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 23 -
Je viens de mettre un zip. Hélas, je voulais mettre une doc sur VBS, mais ce fichier est trop gros.
Signaler
cs_lca94
Messages postés
46
Date d'inscription
mercredi 29 janvier 2003
Statut
Membre
Dernière intervention
28 janvier 2006
 -
notez pour ceux qui cherchent pkoi ça marche pas sur W95 (j'installe chez un client qui a que windows 95) .. il faut installer IE 5.5 a umoins pour que fso fonctionne ... ya dautres trucs aussi comme le computername etc...

Bons exemples je trouve
:)
Signaler
Leirn
Messages postés
30
Date d'inscription
lundi 13 mai 2002
Statut
Membre
Dernière intervention
12 février 2004
 -
Note sur le zip... Je trouve ca plus simple de voir le code ici... Il est peut etre long mais pas mal présenter avec kkes entetes, c bcp plus rapide et moins saoulant que de telecharger un zip et se tapper tous les tests de chaque script (enfin a moins que tu puisse pas comprendre un code quand tu le lis)
Signaler
gmoz22
Messages postés
10
Date d'inscription
mardi 11 juin 2002
Statut
Membre
Dernière intervention
5 août 2005
 -
Un petit conseil pour eviter la redondance de code...
(voir le debut du code de cette page)

Au lieu de faire :

wRepDest1 = "blabla"
wRepDest2 = "bleble"
wRepDest3 = "blibli"

Vaut mieux :

wRepDest(0) = "blabla"
wRepDest(1) = "bleble"
wRepDest(2) = "blibli"

Car cela nous permet de faire :

''''''''''''''''''''''''''''''''''''''''''''''
' Tous les Répertoires '
''''''''''''''''''''''''''''''''''''''''''''''

For i = 0 to UBound(wRepDest)

If Not fso.FolderExists(wRepDest(i)) Then
Set f = fso.CreateFolder(wRepDest(i))
MsgBox "Création du dossier "&f&" effectuée.",vbInformation
fso.MoveFile wSrce(i), wRepDest(i)
Else
MsgBox "Attention:"&vbCrLf&"Le répertoire "&wRepDest(i)&" existe déjà."&vbCrLf&"Les nouveaux fichiers ne sont donc pas archivés",vbCritical
End If

Next



Cela nous permet de rajouter un repertoire en une ligne...
wRepDest(3) = "bloblo"

Voila :)
Afficher les 8 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_JMO)