Změna přípony souborů

Postup:
Do projektu přidejte referenci na Microsoft Scripting Runtime. Tato funkce pracuje pouze s VB6, protože předchozí verze VB nemají InStrRev. Pak je funkce pro změnu přípony souborů následující:

Public Function ChangeExtension(ByVal FolderName As String, _
ByVal NewExtension As String, Optional ByVal OldExtension As _
String = "") As Boolean

   'PARAMETRY: FolderName: Adresář, ve kterém se má operace provést
   'NewExtension: Nová přípona. Nesmí obsahovat tečku.
   'OldExtension: (Volitelné) Pokud je specifikována, změna přípony se provede
   'jenom u souborů s touto příponou, jinak se provede změna přípony
   'u všech souborů v adresáři. Nesmí obsahovat tečku.
   'NÁVRATOVÉ HODNOTY: True pokud vše proběhlo OK, jinak False
   'PŘÍKLAD: ChangeExtension "C:\Inetpub\wwwroot", "asp", "htm"

   Dim oFso As New FileSystemObject
   Dim oFolder As Folder
   Dim oFile As File
   Dim sOldName As String
   Dim sNewName As String
   Dim iCtr As Long
   Dim iDotPosition As Integer
   Dim sWithoutExt As String
   Dim sFolderName As String

   sFolderName = FolderName
   If Right(sFolderName, 1) <> "\" Then sFolderName = _
      sFolderName & "\"
   Set oFolder = oFso.GetFolder(FolderName)

   For Each oFile In oFolder.Files
      sOldName = sFolderName & oFile.Name
      sNewName = ""
      iDotPosition = InStrRev(sOldName, ".")
      If iDotPosition > 0 Then
         If OldExtension = "" Or UCase(Mid(sOldName, _
            iDotPosition + 1)) = UCase(OldExtension) Then
               sWithoutExt = Left(sOldName, iDotPosition - 1)
               sNewName = sWithoutExt & "." & NewExtension
               On Error Resume Next
               Name sOldName As sNewName
                Err.Clear
               On Error GoTo ErrorHandler
         End If
      End If
   Next

   ChangeExtension = True

ErrorHandler:
   Set oFile = Nothing
   Set oFolder = Nothing
   Set oFso = Nothing

End Function

Zpět