Discussion :

[thibmaster]

Bonjour à tous,

Merci pour ce forum bien utile.

Je n'y connais rien du tout en VBScript, mais j'ai vu sur le net que c’était le moyen le plus simple pour faire ce dont j'ai besoins.

Je suis à la recherche d'un script pour renommer automatiquement en masse des fichiers, exporté de Outlook vers l'explorateur, ".MSG" avec les critères suivants:

Mon boss voudrait précisément la re-nomination comme ci-dessous.

"date expéditeur destinataire – objet.MSG"

Quelqu'un a-t-il un script pouvant faire cette tâche sous la main? ou aurait la grande gentillesse de m'en proposer un?

Merci beaucoup
A plus

[l_autodidacte]

Bonjour;

Pour commencer, regarde cette discussion

[thibmaster]

Super, Merci de la réaction rapide!

J'ai été y faire un tour, mais je n'ai rien trouvé qui puisse m'aider.

Je recherche un script qui me permettrait de sélectionner par exemple: 50 ".MSG" et via le menu clique droit sur les fichiers et "sendto" de Microsoft, exécuter le script pour changer le nom du fichier automatiquement.

Merci de votre aide,

[l_autodidacte]

Peut-être le code suivant répond à ta demande(à enregistrer sous le nom Renaming.vbs par exemple).
Il faut une première exécution puis répondre Annuler à l'InputBox pour juste copier le script dans le dossier SendTo.
Ensuite, clic droit sur un fichier ou dossier et envoyer vers ...Renaming.vbs.

Une modification est nécessaire : l'ancienne extension (.MSG) et la nouvelle extension(selon ton souhait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Explicit 
 Dim fso, WS, Ind , oFold, Ext, UsrSendTo
 
 Set fso = CreateObject("Scripting.FileSystemObject") 
 Set WS = CreateObject("Wscript.Shell")
 UsrSendTo = WS.ExpandEnvironmentStrings("%USERPROFILE%") & "\SendTo"
 Ext = InputBox ("Donner la nouvelle extension des fichiers ", "Renommer fichiers",".txt") 
   If Not fso.FileExists(UsrSendTo & "\" & Wscript.ScriptName) Then _
      fso.CopyFile Wscript.ScriptFullName , UsrSendTo & "\" & Wscript.ScriptName, True
  For Ind = 0 To Wscript.Arguments.Count - 1 
     If IsFolder(Wscript.Arguments(Ind)) Then
         oFold = fso.GetFolder(Wscript.Arguments(Ind)).Path 
         ProcessAllFilesInFolder oFold, Ext
     Else  
         ProcessFile fso.GetFile(Wscript.Arguments(Ind)).Path, Ext
     End If
  Next
'================================
  Sub ProcessAllFilesInFolder(Folder, Ext) 
    Dim fso,objFolder,arrFiles 
    Dim SubFolder,TheFile 
    Dim oShell
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    Set arrFiles = objFolder.Files
    If arrFiles.Count = 0 Then 
        MsgBox "Le dossier " & Folder & " ne contient pas de fichiers"
        Exit Sub
    End If
 
    If Ext <> "" Then
        For Each TheFile in arrFiles 
             If UCase(Ext) <> UCase(Right(TheFile.Name, 4)) And UCase(Right(TheFile.Name, 4)) = ".VBS" Then
                TheFile.Name = Left(TheFile.Name, Len(TheFile.Name) - 4 ) + Ext
             End If
        Next
    Else  
       On Error Resume Next 
    End If
End Sub
'===============================
Sub ProcessFile(sFile, Ext)
   Dim Fichier 
   Set Fichier = fso.GetFile(sFile)
 
   If UCase(Right(Fichier.Name, 4)) = ".VBS" Then _
   Fichier.Name = Left(Fichier.Name, Len(Fichier.Name) - 4 ) + Ext
End Sub
'===============================
Function IsFolder(strIn)
   Dim Ret,FF
   On Error Resume Next
   Set FF = fso.GetFolder(strIn)
   If FF.Attributes And Archive Then 
      FF.Attributes = FF.Attributes  - Archive
   ElseIf FF.Attributes And ReadOnly Then 
      FF.Attributes = FF.Attributes  - ReadOnly
   ElseIf FF.Attributes And Hidden  Then
      FF.Attributes = FF.Attributes  - Hidden
   ElseIf FF.Attributes And Compressed Then
      FF.Attributes = FF.Attributes  - Compressed
   End If      
 
   If Not IsFolder(strIn) Then Set FF = fso.GetFile(strIn)
   IsFolder  = FF.Attributes = 16    
End Function

[ericdeumo]

Bonjour.
J'ai le même problème. Quelqu'un a t'il eu la solution ?

[ProgElecT]

Salut

Le titre de la discussion est VBScript renommer fichier ".MSG" et une solution est donnée dans cette discussion, dis nous ou tu bloques, il y a surement une adaptation à faire, mais pour cela il faut que tu nous précise ta propre problématique.