Changing the extensions of all files of a certain type in a folder

Changing the extensions of all files of a certain type in a folder

Sometimes you might be presented with a folder full of files with an extension that needs changing. This is quite easy to do in Access. Here I have two procedures to do this, one only to change the extensions of files within a given folder, excluding any sub-folders, and the other will also work on any files within sub-folders:

Option Compare Database
Option Explicit

Sub sFileExtension1(strDirectory As String, strOldExtension As String, strNewExtension As String)
'   Procedure to loop through all files in a directory (excluding sub-directories)
'   and rename any that have a certain file extension to have a new file extension.
'   Accepts:
'       strDirectory - the directory that the files are located in
'       strOldExtension - the old file extension, ie "txt"
'       strNewExtension - the new file extension, ie "dat"
    Dim strOldFile As String, strNewFile As String
    If Right(strDirectory, 1) <> "\" Then strDirectory = strDirectory & "\"
    strOldFile = Dir(strDirectory, vbNormal)
    Do While strOldFile <> ""
        If Right(strOldFile, Len(strOldExtension)) = strOldExtension Then
            strNewFile = strDirectory & Left(strOldFile, Len(strOldFile) - Len(strOldExtension)) & strNewExtension
            Name strDirectory & strOldFile As strNewFile
        End If
        strOldFile = Dir
    Loop
End Sub

Sub sFileExtension2(strDirectory As String, strOldExtension As String, strNewExtension As String)
'   Procedure to loop through all files in a directory (including sub-directories by recursively calling the procedure)
'   and rename any that have a certain file extension to have a new file extension.
'   Accepts:
'       strDirectory - the directory that the files are located in
'       strOldExtension - the old file extension, ie "txt"
'       strNewExtension - the new file extension, ie "dat"
    Dim strOldFile As String, strNewFile As String
    Dim astrDirectory() As String
    Dim intDirectoryCount As Integer
    Dim intLoop As Integer
    intDirectoryCount = 1
    ReDim astrDirectory(1 To 100)
    If Right(strDirectory, 1) <> "\" Then strDirectory = strDirectory & "\"
    strOldFile = Dir(strDirectory, vbNormal)
    Do While strOldFile <> ""
        If Right(strOldFile, Len(strOldExtension)) = strOldExtension Then
            strNewFile = strDirectory & Left(strOldFile, Len(strOldFile) - Len(strOldExtension)) & strNewExtension
            Name strDirectory & strOldFile As strNewFile
        End If
        strOldFile = Dir
    Loop
    strOldFile = Dir(strDirectory, vbDirectory)
    Do While strOldFile <> ""
        If GetAttr(strDirectory & strOldFile) And vbDirectory Then
            If strOldFile <> "." And strOldFile <> ".." Then
                astrDirectory(intDirectoryCount) = strDirectory & strOldFile
                intDirectoryCount = intDirectoryCount + 1
                If intDirectoryCount Mod 100 = 0 Then ReDim Preserve astrDirectory(1 To intDirectoryCount + 100)
            End If
        End If
        strOldFile = Dir
    Loop
    For intLoop = 1 To intDirectoryCount - 1
        sFileExtension2 astrDirectory(intLoop), strOldExtension, strNewExtension
    Next intLoop
End Sub

Top

Last modified at 06/06/2006 14:58:06