Fine and Replace the string in the folder name and subfoldernames using INstr and replace function

Gopinath dharmarajn
Gopinath dharmarajn used Ask the Experts™
on
Hi ,

i need the help for vba code using replace and Instr function


sub test()

dim filename As string
Dim filepath As String
Dim filerename AS string

filepath = "c:\"

filename = Instr(filepath,cert)

filerename = Replace(filename , "cert" , "cert1")


End sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Shaun VermaakTechnical Specialist
Awarded 2017
Distinguished Expert 2018

Commented:
Try
filerename = filename.Replace("cert", "cert1")

Open in new window

ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
You may try something like this:
Sub RenameFiles()
    Dim fs As FileSystemObject
    Dim fdBase As Folder
    Dim f As File
    Dim sFV As String
    Dim sTV As String
    Dim sPath As String
    Dim sName As String
    Dim sFullName As String
    sPath = "c:\"
    sFV = "cert"
    sTV = "cert1"
    Set fs = New FileSystemObject
    If Not fs.FolderExists(sPath) Then
        MsgBox "Invalid Path"
        Exit Sub
    End If
    Set fdBase = fs.GetFolder(sPath)
    For Each f In fdBase.Files
        sName = f.Name
        sName = Replace(sName, sFV, sTV)
        sFullName = f.ParentFolder & "\" & sName
        Name f As sFullName
    Next
    
    For Each fd In fdBase.SubFolders
        For Each f In fd.Files
            If f.Name Like "*" & sFV & "*" Then
                sName = f.Name
                sName = Replace(sName, sFV, sTV)
                sFullName = f.ParentFolder & "\" & sName
                Name f As sFullName
            End If
        Next
    Next
End Sub

Open in new window

Top Expert 2016
Commented:
Hi,

pls try
Sub Macro()
Const filePath As String = "C:\" '// Change as required
Dim files As Variant
strFrom = "cert"
strTo = "cert1"
Folders = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & filePath & """  /s /b /o:n /ad").StdOut.ReadAll, vbCrLf)
Folders1 = Filter(Folders, strFrom)
For Each fld In Folders1
    If fld = "" Then Exit For
    pos = InStrRev(fld, "\")
    strFld = Mid(fld, pos)
    If strFld Like "*" & strFrom & "*" Then
        Name VBA.replace(Left(fld, pos - 1), strFrom, strTo) & strFld As VBA.replace(fld, strFrom, strTo)
    End If
Next 
End Sub

Open in new window

Shums code does only one subfolder level

Regards
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018
Commented:
Yes Sir, I already noticed after testing. Improved version would be allowing user to select folder:
Sub FindReplace()
Dim myfolder
Dim Fnd As String, Rplc As String
Fnd = "cert"
Rplc = "cert1"
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    myfolder = .SelectedItems(1) & "\"
End With
Call Recursive(myfolder, Fnd, Rplc)
End Sub
Sub Recursive(FolderPath As Variant, Fnd As String, Rplc As String)
Dim Value As String, Folders() As String, Fname As String, Fext As String
Dim x As Integer
Dim Folder As Variant, a As Long
ReDim Folders(0)

If Right(FolderPath, 2) = "\\" Then Exit Sub
Value = Dir(FolderPath, &H1F)
Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then
                    Name FolderPath & Value As FolderPath & WorksheetFunction.Substitute(Value, Fnd, Rplc)
                Value = WorksheetFunction.Substitute(Value, Fnd, Rplc)
                If Err <> 0 Then
                    MsgBox "Error"
                    Exit Sub
                End If
            On Error GoTo 0
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            On Error Resume Next
                Fext = Split(Value, ".")(UBound(Split(Value, ".")))
                Fname = Left(Value, Len(Value) - Len(Split(Value, ".")(UBound(Split(Value, ".")))) - 1)
                Fname = WorksheetFunction.Substitute(Fname, Fnd, Rplc)
                If Value <> (Fname & "." & Fext) Then
                        Name FolderPath & Value As FolderPath & Fname & "." & Fext
                End If
                If Err <> 0 Then
                    MsgBox "Error"
                    Exit Sub
                End If
            On Error GoTo 0
        End If
    End If
    Value = Dir
Loop
For Each Folder In Folders
    Call Recursive(FolderPath & Folder & "\", Fnd, Rplc)
Next Folder
End Sub

Open in new window

ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
No comment has been added to this question in more than 14 days, so it is now classified as abandoned.

I have recommended this question be closed as follows:
Split: Rgonzo (ID: 42051107) and Shums (ID: 42051138)

If you feel this question should be closed differently, post an objection and a moderator will read all objections and then close it as they feel fit. If no one objects, this question will be closed automatically the way described above.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial