Renaming Network Files

ghudson · Sep 22, 2004

Is it possible to search a specific network drive and rename all files that have a comma in the file name? (Don't ask why but they do ;-)

I need to search a network drive, find and rename hundreds of files that have a comma within the file name. I need the file name to basically stay the same. I just want to replace the comma with an underscore character. Like this...

October,21,1998.xls should be renamed to October_21_1998.xls
Period05,Year2001,Qtr2.xls should be renamed to Period05_Year2001_Qtr2.xls

How can I do this VBA?

Thanks in advance for your help!

WayneRyan · Sep 22, 2004

g,

Hey, that was fun!

Very limited testing (lunchtime), but should handle multiple commas.
It is limited to one directory and one file extension.
Let me know, will have more time later.

Code:

Dim OldFN As String
Dim NewFN As String
Dim Path As String
Path = "\\SomeServer\SomeFolder\"
OldFN = Dir(Path & "*.tst")
While OldFN <> ""
   NewFN = OldFN
   While InStr(1, NewFN, ",") > 0
     NewFN = Mid(NewFN, 1, InStr(1, NewFN, ",") - 1) & "_" & Mid(NewFN, InStr(1, NewFN, ",") + 1)
     Wend
     If OldFN <> NewFN Then
        Name Path & OldFN As Path & NewFN
     End If
   OldFN = Dir
   Wend

Wayne

ByteMyzer · Sep 22, 2004

This might serve better, especially for older versions of VBA, using the FileSystemObject's MoveFile to rename the files. It works for one directory (does not blow through subdirectories), and accomodates all extensions:

Code:

Public Sub BatchRename(ByVal filePath As String)

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim bFileName As String

    If Right(filePath, 1) <> "\" Then filePath = filePath & "\"

    bFileName = Dir(filePath & "*,*")

    Do While bFileName > ""
        fso.MoveFile filePath & bFileName, _
            filePath & Replace(bFileName, ",", "_", , , vbBinaryCompare)
        bFileName = Dir
    Loop

    Set fso = Nothing

End Sub

For example, calling this Sub with:

BatchRename "C:\MyFolder\"

...will replace all commas with underscores in the filenames in C:\MyFolder\.

ghudson · Sep 22, 2004

Thanks Wayne. That works for a single directory but now I am brain locked on how to loop it through all unknown sub directories. I have tried unsuccessfully to incorporate your code with some code that I use for searching directories. I think that you might have provided the code below some time back [if not, I apologize to the originator]. Can you spot where I am failing to get this to work with your comma replacing code? Thanks!!!

Code:

Option Compare Database
Option Explicit

Public Function Testing()
    ReplaceCommas ("C:\Temp\CommaTesting\")
End Function

Public Sub ReplaceCommas(ByVal Path As String)
On Error GoTo Err_ReplaceCommas

    Dim fName As String
    Dim dName As String
    Dim d As Integer
    Dim subDirs() As String
    
    'check current dir
    'fName = Dir(path & "*.mdb")
    fName = Dir(Path & "*.*")
'new
    Do Until fName = ""
        Dim OldFN As String
        Dim NewFN As String
'        Dim Path As String
'        Path = "C:\Temp\CommaTesting\"
        OldFN = Dir(Path & "*.*")
        While OldFN <> ""
            NewFN = OldFN
            While InStr(1, NewFN, ",") > 0
            NewFN = Mid(NewFN, 1, InStr(1, NewFN, ",") - 1) & "_" & Mid(NewFN, InStr(1, NewFN, ",") + 1)
            Wend
                If OldFN <> NewFN Then
                    Name Path & OldFN As Path & NewFN
                End If
           OldFN = Dir
           Wend
'new
        fName = Dir
    Loop
    
    'then recursive check subdirs
    dName = Dir(Path, vbDirectory)
    d = 0
    
    Do Until dName = ""
        If Not (dName = "." Or dName = ".." Or dName = "pagefile.sys" Or dName = "?") Then
            If (GetAttr(Path & dName) And vbDirectory) = vbDirectory Then
                d = d + 1
                ReDim Preserve subDirs(d)
                subDirs(d) = dName
            End If
        End If
        dName = Dir
    Loop
    
    Do Until d = 0
        ReplaceCommas (Path & subDirs(d) & "\")
        d = d - 1
    Loop

Exit_ReplaceCommas:
    Exit Sub

Err_ReplaceCommas:
    If Err = 76 Then 'Path not found
        'continue
    Else
        MsgBox Err.Number & " " & Err.Description
        Resume Exit_ReplaceCommas
    End If

End Sub

ByteMyzer · Sep 22, 2004

Here is a version of BatchRename which will also recurse through the subdirectories like you requested:

Code:

Public Sub BatchRename(ByVal dirPath As String)
On Error Resume Next

    Dim dirFso
    Dim dirCol As New Collection
    Dim dirIndex As Long
    Dim dirMain As String
    Dim dirSub As String

    Set dirFso = CreateObject("Scripting.FileSystemObject")
    If Right(dirPath, 1) = "\" Then dirPath = Left(dirPath, Len(dirPath) - 1)

    dirCol.Add dirPath
    dirIndex = 1

    Do While dirIndex <= dirCol.Count
        dirMain = dirCol(dirIndex)
        dirIndex = dirIndex + 1
        dirSub = Dir(dirMain & "\*", vbDirectory)
        Do While dirSub <> ""
            If UCase(dirSub) <> "PAGEFILE.SYS" _
                And dirSub <> "." And dirSub <> ".." Then
                If GetAttr(dirMain & "\" & dirSub) And vbDirectory Then _
                    dirCol.Add dirMain & "\" & dirSub
                If dirSub Like "*,*" Then
                    dirFso.MoveFile dirMain & "\" & dirSub, dirMain & "\" _
                        & Replace(dirSub, ",", "_", , , vbBinaryCompare)
                End If
            End If
            dirSub = Dir(, vbDirectory)
        Loop
    Loop


End Sub

For older versions of Access/VBA without the built-in Replace function, here is the code:

Code:

Public Function Replace(sIn As String, sFind As String, _
      sReplace As String, Optional nStart As Long = 1, _
      Optional nCount As Long = -1, Optional bCompare As _
      Long = vbBinaryCompare) As String

    Dim nC As Long, nPos As Long, sOut As String
    sOut = sIn
    nPos = InStr(nStart, sOut, sFind, bCompare)
    If nPos = 0 Then GoTo EndFn:
    Do
        nC = nC + 1
        sOut = Left(sOut, nPos - 1) & sReplace & _
           Mid(sOut, nPos + Len(sFind))
        nPos = Len(Left(sOut, nPos) & sReplace)
        If nCount <> -1 And nC >= nCount Then Exit Do
        If nPos Then nPos = InStr(nPos, sOut, sFind, bCompare)
    Loop While nPos > 0
EndFn:
    Replace = sOut
End Function

See if this works for you.

ghudson · Sep 23, 2004

Thank you ByteMyzer! I just tested the Access 97 version of the BatchRename() with your Replace() function and it works great!

Renaming Network Files

ghudson

Registered User.

WayneRyan

AWF VIP

ByteMyzer

AWF VIP

ghudson

Registered User.

ByteMyzer

AWF VIP

ghudson

Registered User.

Similar threads

Users who are viewing this thread