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
| Sub StripArticle(fold)
'--La structure des noms des fichiers mp3 est: texte1;texte2;text3;texte4.mp3
'--Cette routine déplace "les articles Le La Les L'" derrière le substantif
'--et passe en majuscule la première lettre du nom de fichier
'-- elle traite tous les fichiers mp3 dans fold folder
Dim strExt, mpFiles, strName, foldName, foldPath, f
Dim strTab, strTab1, StrNameInchanged, Tmp, strTempo
foldPath = fold.Path
Set mpfiles = fold.Files
For each f in mpfiles
strName = f.Name
strExt = LCase(fso.GetExtensionName(strName))
If strExt = sExtToGet Then ' c'est un fichier mp3 alors traitement
If a sc((Left(strName,1))) > 96 Then ' met la 1ere lettre en majuscule
strTempo = Ucase(Left(f.Name,1)) & Mid(f.Name,2)
msgbox("filename = " & strTempo)
f.Name = strTempo
End if
strName = Ucase(Left(f.Name,1)) & Mid(f.Name,2)
If Left(strName,2)= "L'" Then
strName= Left(strName,2) & " " & Mid(strName,3) ' Mise en forme pour le L': ajout d'1 espace
End if
If Left(strName,1)= "L" Then 'le titre commence par un L
Tmp= Instr(1,strName,";",1)
If Tmp > 0 Then
StrNameInchanged= Mid(StrName,Tmp)
StrName= Left(strName,Instr(1,strName,";",1)-1)
End if
strTab = Split(strName," ",-1,1) 'eclate le titre selon les espaces
If Len(strTab(0))<= 3 Then 'le 1er L appartient a un article ?
If InStr("LeLaLesL'",strTab(0)) > 0 Then
Select Case strTab (0)
Case "Le"
strTab (0)= Ucase(Left(strTab (1),1)) & Mid(strTab (1),2)
strTab (1)="(Le)"
Case "La"
strTab (0)= Ucase(Left(strTab (1),1)) & Mid(strTab (1),2)
strTab (1)="(La)"
Case "Les"
strTab (0)= Ucase(Left(strTab (1),1)) & Mid(strTab (1),2)
strTab (1)="(Les)"
Case "L'"
strTab (0)= Ucase(Left(strTab (1),1)) & Mid(strTab (1),2)
strTab (1)="(L')"
End select
msgbox("strTempo = " & join(strTab," ")& StrNameInchanged)
strTempo=join(strTab," ")& StrNameInchanged
f.Name = strTempo
Cpt=Cpt+1
end if 'Instr
End if 'Len
End if 'Left
End If 'strExt
Next
End Sub |
Partager