[VBA Excel] Renommer un fichier Word sous Exc
Résolu/Fermé
mario90
Messages postés
29
Date d'inscription
lundi 15 avril 2002
Statut
Membre
Dernière intervention
18 septembre 2014
-
13 juin 2007 à 14:27
touco - 5 janv. 2008 à 11:25
touco - 5 janv. 2008 à 11:25
A voir également:
- [VBA Excel] Renommer un fichier Word sous Exc
- Fichier rar - Guide
- Word et excel gratuit - Guide
- Comment ouvrir un fichier epub ? - Guide
- Comment réduire la taille d'un fichier - Guide
- Renommer plusieurs fichiers - Guide
1 réponse
Dans excel, cocher Référence : microsoft scripting runtime
voila un code qui renome des fichiers sans les ouvrir...
Sub chgtnom()
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFl As File
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
repertoire = "D:\repertoire\"
' valeur 145
valeur = activesheet.cells(1,1).value
' Verifie que le répertoire existe
If oFSO.FolderExists(repertoire) Then
Else
i = MsgBox("Le repertoire est inexistant" & Chr(10) & "Verifier le chemin", vbOKOnly, "Et non !")
Exit Sub
End If
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx recherche et traitement des fichiers xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Accède au répertoire du départ de recherche
Set oFld = oFSO.GetFolder(repertoire)
' pour chaque fichier ...
For Each oFl In oFld.Files
' de type DOC
If UCase(Right(oFl.Name, 3)) = "DOC" Then
' pas déja traité
If InStr(oFl.Name, right(str(valeur),len(str(valeur))-1)) <> 0 Then
oFl.Name = Left(oFl.Name,len(oFl.name)-4) & "_" & right(str(valeur), len(str(valeur))-1) & ".doc"
End If
End If
Next
End Sub
Voila qui devrait t'aider !
voila un code qui renome des fichiers sans les ouvrir...
Sub chgtnom()
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFl As File
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
repertoire = "D:\repertoire\"
' valeur 145
valeur = activesheet.cells(1,1).value
' Verifie que le répertoire existe
If oFSO.FolderExists(repertoire) Then
Else
i = MsgBox("Le repertoire est inexistant" & Chr(10) & "Verifier le chemin", vbOKOnly, "Et non !")
Exit Sub
End If
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx recherche et traitement des fichiers xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Accède au répertoire du départ de recherche
Set oFld = oFSO.GetFolder(repertoire)
' pour chaque fichier ...
For Each oFl In oFld.Files
' de type DOC
If UCase(Right(oFl.Name, 3)) = "DOC" Then
' pas déja traité
If InStr(oFl.Name, right(str(valeur),len(str(valeur))-1)) <> 0 Then
oFl.Name = Left(oFl.Name,len(oFl.name)-4) & "_" & right(str(valeur), len(str(valeur))-1) & ".doc"
End If
End If
Next
End Sub
Voila qui devrait t'aider !