Folderpath Edit VBA

O

Oreynolds

Member
Local time
Today, 23:46
Joined
Apr 11, 2020
Messages
165
Hi,

I have some code which alters the final subfolder name in a folderpath. The code works fine.

However, I now want to be able to edit the name of a folder in the middle of the path, i.e. a folder that contains a number of sub-folders. The code I am using errors when I try this. Does anyone know if its possible and what the best VBA function to do it is?

So to be clear - If the rs!SiteName is altered then the code below happily amends the folderpath, however if it is the rs!CompanyName that has changed and needs renaming then the code fails to work.......

Code: 
Set rs = CurrentDb.OpenRecordset(strSQLJOBS)
    rs.MoveLast
    rs.MoveFirst
    Do Until rs.EOF

        rs.Edit

        Foldername = rs!folderpath
        FoldernameNew = "F:\SFA 20" & Right(rs!OrderDate, 2) & "\Running projects\" & rs!CompanyName & "\J" & rs!OrderID & " " & rs!SiteName & "\"
        
        If Not FolderExists(Foldername) Then
        'Foldername doesn't exist so do nothing
        rs!folderpath = "Not Set"
        Else
        'Foldername does exist so rename it and set folderpath for record to new foldername
        Name Foldername As FoldernameNew
        rs!folderpath = FoldernameNew
        End If

        rs.Update
        rs.MoveNext
    Loop
    Set rs = Nothing
 
I don't know about Name command. But FSO can do it.
Use this sub, pass the old name and new name of the folder

SQL: 
Sub Move_Rename_Folder(FromPath As String, ToPath As String)
   Dim FSO As Object
   
    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If
    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = True Then
        MsgBox ToPath & " exist, not possible to move to a existing folder"
        Exit Sub
    End If

    FSO.MoveFolder Source:=FromPath, Destination:=ToPath

End Sub

Use it something like :
Move_Rename_Folder Foldername , FoldernameNew
 
Hi, just to be clear I don’t want to rename files, I want to rename a folder in the middle of a folder path, so as an example;

I want to rename the following original folder path

C:\FolderA\FolderB\FolderC\FolderD\

to;

C:\FolderA\FolderABC\FolderC\FolderD\
 
Sun_Force said:
I don't know about Name command. But FSO can do it.
Use this sub, pass the old name and new name of the folder

SQL: 
Sub Move_Rename_Folder(FromPath As String, ToPath As String)
   Dim FSO As Object
  
    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If
    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = True Then
        MsgBox ToPath & " exist, not possible to move to a existing folder"
        Exit Sub
    End If

    FSO.MoveFolder Source:=FromPath, Destination:=ToPath

End Sub

Use it something like :
Move_Rename_Folder Foldername , FoldernameNew
Click to expand...

Thanks, reference my more recent post below do you still think this would work? I guess I’d have to then delete the original Folder?
 
Oreynolds said:
Hi, just to be clear I don’t want to rename files, I want to rename a folder in the middle of a folder path, so as an example;

I want to rename the following original folder path

C:\FolderA\FolderB\FolderC\FolderD\

to;

C:\FolderA\FolderABC\FolderC\FolderD\
Click to expand...
You simply have to use it this way :

Move_Rename_Folder "C:\FolderA\FolderB", "C:\FolderA\FolderABC"

Don't mind the trailing path.
 
I just tried Name command.
Name works too and can rename a folder in the middle of a path.

If you're receiving an error, it's because you are adding the trailing path.
You have to use it this way:

Name "C:\FolderA\FolderB" AS "C:\FolderA\FolderABC"

You have to drop the \FolderC\FolderD\ section.
Even if you have child folders, you don't need to mention them in rename process.
 
Last edited:
If you have a fully qualified file spec including the path, consider using the Replace function in VBA to change one folder to another.

Code: 
OldSpec = "C:\FolderA\FolderB\FolderC\FolderD\"
NewSpec = Replace( OldSpec, "\FolderB\", "\FolderABC\" )

Then NewSpec would contain "C:\FolderA\FolderABC\FolderC\FolderD\" - which ought to be enough to get you going on your re-pathing. After that, either the Name As or FileSystemObject approaches should work.
 
paste this on New Module:
Code: 
Public Function fncRenameFolder(ByVal oldFolderName As String, ByVal newFolderName As String) As Boolean
    Dim var1, var2
    Dim i As Integer, j As Integer, k As Integer
    Dim pi As String
    Dim po As String
    var1 = Split(oldFolderName, "\")
    var2 = Split(newFolderName, "\")
    i = UBound(var1)
    j = UBound(var2)
    If i <> j Then
        MsgBox "Unable to Rename folder, size not the same."
        Exit Function
    End If
    On Error Resume Next
    For k = i To 0 Step -1
        pi = "": po = ""
        For j = 0 To k
            pi = pi & var1(j) & "\"
            po = po & var2(j) & "\"
        Next
        If k > 0 Then
            pi = Left$(pi, Len(pi) - 1)
            po = Left$(po, Len(po) - 1)
            Name pi As po
        End If
    Next
    fncRenameFolder = True
End Function

your code need to change to:
Code: 
Set rs = CurrentDb.OpenRecordset(strSQLJOBS)
    rs.MoveLast
    rs.MoveFirst
    Do Until rs.EOF

        rs.Edit

        Foldername = rs!folderpath
        FoldernameNew = "F:\SFA 20" & Right(rs!OrderDate, 2) & "\Running projects\" & rs!CompanyName & "\J" & rs!OrderID & " " & rs!SiteName & "\"
        
        If Not FolderExists(Foldername) Then
        'Foldername doesn't exist so do nothing
        rs!folderpath = "Not Set"
        Else
        'Foldername does exist so rename it and set folderpath for record to new foldername
        Call fncRenameFolder(Foldername, FoldernameNew)
        rs!folderpath = FoldernameNew
        End If

        rs.Update
        rs.MoveNext
    Loop
    Set rs = Nothing
 
arnelgp said:
paste this on New Module:
Code: 
Public Function fncRenameFolder(ByVal oldFolderName As String, ByVal newFolderName As String) As Boolean
    Dim var1, var2
    Dim i As Integer, j As Integer, k As Integer
    Dim pi As String
    Dim po As String
    var1 = Split(oldFolderName, "\")
    var2 = Split(newFolderName, "\")
    i = UBound(var1)
    j = UBound(var2)
    If i <> j Then
        MsgBox "Unable to Rename folder, size not the same."
        Exit Function
    End If
    On Error Resume Next
    For k = i To 0 Step -1
        pi = "": po = ""
        For j = 0 To k
            pi = pi & var1(j) & "\"
            po = po & var2(j) & "\"
        Next
        If k > 0 Then
            pi = Left$(pi, Len(pi) - 1)
            po = Left$(po, Len(po) - 1)
            Name pi As po
        End If
    Next
    fncRenameFolder = True
End Function

your code need to change to:
Code: 
Set rs = CurrentDb.OpenRecordset(strSQLJOBS)
    rs.MoveLast
    rs.MoveFirst
    Do Until rs.EOF

        rs.Edit

        Foldername = rs!folderpath
        FoldernameNew = "F:\SFA 20" & Right(rs!OrderDate, 2) & "\Running projects\" & rs!CompanyName & "\J" & rs!OrderID & " " & rs!SiteName & "\"
       
        If Not FolderExists(Foldername) Then
        'Foldername doesn't exist so do nothing
        rs!folderpath = "Not Set"
        Else
        'Foldername does exist so rename it and set folderpath for record to new foldername
        Call fncRenameFolder(Foldername, FoldernameNew)
        rs!folderpath = FoldernameNew
        End If

        rs.Update
        rs.MoveNext
    Loop
    Set rs = Nothing
Click to expand...

Thanks very much for this. I have tried this and it works fine, The only issue I have now is if 2 of the folder names have changed, for example:

If Foldername = "C:\FolderA\FolderB\FolderC\FolderD\"

And I set FoldernameNew = "C:\FolderA\FolderB\FolderCDE\FolderDEF\"

The function as it stands is only changing the name of the first altered folername in the string, i.e in this case it only changes the name of FolderC

Is this a limitation that can be overcome?
 
no limitation, only it's not performing the Correct logic.
see this modification.
Code: 
Public Function fncRenameFolder(ByVal oldFolderName As String, ByVal newFolderName As String) As Boolean
    Dim var1, var2
    Dim i As Integer, j As Integer, k As Integer
    Dim pi As String
    Dim po As String
    var1 = Split(oldFolderName, "\")
    var2 = Split(newFolderName, "\")
    i = UBound(var1)
    j = UBound(var2)
    If i <> j Then
        MsgBox "Unable to Rename folder, size not the same."
        Exit Function
    End If
    On Error Resume Next
    For k = i To 0 Step -1
        pi = "": po = ""
        For j = 0 To k
            pi = pi & var1(j) & "\"
            If j = k Then
                po = po & var2(j) & "\"
            Else
                po = po & var1(j) & "\"
            End If
        Next
        If k > 0 Then
            pi = Left$(pi, Len(pi) - 1)
            po = Left$(po, Len(po) - 1)
            Name pi As po
        End If
    Next
    fncRenameFolder = True
End Function
 
arnelgp said:
no limitation, only it's not performing the Correct logic.
see this modification.
Code: 
Public Function fncRenameFolder(ByVal oldFolderName As String, ByVal newFolderName As String) As Boolean
    Dim var1, var2
    Dim i As Integer, j As Integer, k As Integer
    Dim pi As String
    Dim po As String
    var1 = Split(oldFolderName, "\")
    var2 = Split(newFolderName, "\")
    i = UBound(var1)
    j = UBound(var2)
    If i <> j Then
        MsgBox "Unable to Rename folder, size not the same."
        Exit Function
    End If
    On Error Resume Next
    For k = i To 0 Step -1
        pi = "": po = ""
        For j = 0 To k
            pi = pi & var1(j) & "\"
            If j = k Then
                po = po & var2(j) & "\"
            Else
                po = po & var1(j) & "\"
            End If
        Next
        If k > 0 Then
            pi = Left$(pi, Len(pi) - 1)
            po = Left$(po, Len(po) - 1)
            Name pi As po
        End If
    Next
    fncRenameFolder = True
End Function
Click to expand...

Thanks so much, works perfectly on my test folders! No I've just got to risk running it on our actual data folders!
 
arnelgp said:
no limitation, only it's not performing the Correct logic.
see this modification.
Code: 
Public Function fncRenameFolder(ByVal oldFolderName As String, ByVal newFolderName As String) As Boolean
    Dim var1, var2
    Dim i As Integer, j As Integer, k As Integer
    Dim pi As String
    Dim po As String
    var1 = Split(oldFolderName, "\")
    var2 = Split(newFolderName, "\")
    i = UBound(var1)
    j = UBound(var2)
    If i <> j Then
        MsgBox "Unable to Rename folder, size not the same."
        Exit Function
    End If
    On Error Resume Next
    For k = i To 0 Step -1
        pi = "": po = ""
        For j = 0 To k
            pi = pi & var1(j) & "\"
            If j = k Then
                po = po & var2(j) & "\"
            Else
                po = po & var1(j) & "\"
            End If
        Next
        If k > 0 Then
            pi = Left$(pi, Len(pi) - 1)
            po = Left$(po, Len(po) - 1)
            Name pi As po
        End If
    Next
    fncRenameFolder = True
End Function
Click to expand...
Hi, one further question if you don’t mind. I am trying to learn and understand how to write code more efficiently without repeating myself. So, in my code above I currently loop through my recordset called “strSQLJobs“. However I need to do this exact same loop for 5 x different recordsets from 5 different tables, as an example;

strSQL1
strSQL2
strSQL3
strSQL4
strSQL5

Are you able to show me how I can select the first sql recordset, run the loop I have already written, then select the next recordset, repeat the loop and so on until all recordsets have been completed?

Thanks again for your help so far.
 
there are Many ways to do what you want.
one of those is using Array to hold each SQL:
Code: 
Private Sub m()
    Dim arSQL(1 To 5) As String
    Dim i As Integer
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    arSQL(1) = "select * from table1;"
    arSQL(2) = "select * from table2;"
    arSQL(3) = "select * from table3;"
    arSQL(4) = "select * from table4;"
    arSQL(5) = "select * from table5;"
    Set dbs = CurrentDb
    For i = 1 To 5
        Set rst = dbs.OpenRecordset(arSQL(i), dbOpenDynaset)
        'do same routine for the 5 recordset (1 at a time)
        Call processRst(rst, i)
        rst.Close
        Set rst = Nothing
    Next
End Sub


Private Sub processRst(ByRef rst As DAO.Recordset, i As Integer)
    'your process here
    'Note that i passed the second parameter (i).
    'so if there is special condition for each
    'recordset, you can determine which recordset is passed
    'by this number.
End Sub
 
arnelgp said:
Code: 
Private Sub cmdUpdateFolderpaths_Click()

    Dim arSQL(1 To 5) As String
    Dim i As Integer
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    arSQL(1) = "select * from table1;"
    arSQL(2) = "select * from table2;"
    arSQL(3) = "select * from table3;"
    arSQL(4) = "select * from table4;"
    arSQL(5) = "select * from table5;"
    
    Set db = CurrentDb
    
    For i = 1 To 5
        Set rs = db.OpenRecordset(arSQL(i), dbOpenDynaset)
        'do same routine for the 5 recordset (1 at a time)
        Call UpdateFolderpaths(rs, i)
        rs.Close
        
        Set rs = Nothing
    Next
    
End Sub


Private Sub UpdateFolderpaths(ByRef rs As DAO.Recordset, i As Integer)
    
Dim lngCounter As Long
    
    rs.MoveLast
    rs.MoveFirst
    Do Until rs.EOF

        rs.Edit

        If i = 1 Then
        rs!folderpath = "FoldernameNew1"
        ElseIf i = 2 Then
        rs!folderpath = "FoldernameNew2"
        ElseIf i = 3 Then
        rs!folderpath = "FoldernameNew3"
        ElseIf i = 4 Then
        rs!folderpath = "FoldernameNew4"
        ElseIf i = 5 Then
        rs!folderpath = "FoldernameNew5"
        End If
        
        lngCounter = lngCounter + 1
        
        rs.Update
        rs.MoveNext
    
    Loop

    If i = 1 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in Jobs")
    If i = 2 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in FRA's")
    If i = 3 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in Reactives")
    If i = 4 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in Maintenance Jobs")
    If i = 5 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in Site Info")
        
End Sub
there are Many ways to do what you want.
one of those is using Array to hold each SQL:
Code: 
Private Sub m()
    Dim arSQL(1 To 5) As String
    Dim i As Integer
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    arSQL(1) = "select * from table1;"
    arSQL(2) = "select * from table2;"
    arSQL(3) = "select * from table3;"
    arSQL(4) = "select * from table4;"
    arSQL(5) = "select * from table5;"
    Set dbs = CurrentDb
    For i = 1 To 5
        Set rst = dbs.OpenRecordset(arSQL(i), dbOpenDynaset)
        'do same routine for the 5 recordset (1 at a time)
        Call processRst(rst, i)
        rst.Close
        Set rst = Nothing
    Next
End Sub


Private Sub processRst(ByRef rst As DAO.Recordset, i As Integer)
    'your process here
    'Note that i passed the second parameter (i).
    'so if there is special condition for each
    'recordset, you can determine which recordset is passed
    'by this number.
End Sub
Click to expand...

Thankyou so much, that is really helpful and as a result I have learned a lot. I have rewritten it slightly and added a process and some counting in as follows, all thanks to your assistance. Much appreciated!

Code: 
Private Sub cmdUpdateFolderpaths_Click()

    Dim arSQL(1 To 5) As String
    Dim i As Integer
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    arSQL(1) = "select * from table1;"
    arSQL(2) = "select * from table2;"
    arSQL(3) = "select * from table3;"
    arSQL(4) = "select * from table4;"
    arSQL(5) = "select * from table5;"
    
    Set db = CurrentDb
    
    For i = 1 To 5
        Set rs = db.OpenRecordset(arSQL(i), dbOpenDynaset)
        'do same routine for the 5 recordset (1 at a time)
        Call UpdateFolderpaths(rs, i)
        rs.Close
        
        Set rs = Nothing
    Next
    
End Sub


Private Sub UpdateFolderpaths(ByRef rs As DAO.Recordset, i As Integer)
    
Dim lngCounter As Long
    
    rs.MoveLast
    rs.MoveFirst
    Do Until rs.EOF

        rs.Edit

        If i = 1 Then
        rs!folderpath = "FoldernameNew1"
        ElseIf i = 2 Then
        rs!folderpath = "FoldernameNew2"
        ElseIf i = 3 Then
        rs!folderpath = "FoldernameNew3"
        ElseIf i = 4 Then
        rs!folderpath = "FoldernameNew4"
        ElseIf i = 5 Then
        rs!folderpath = "FoldernameNew5"
        End If
        
        lngCounter = lngCounter + 1
        
        rs.Update
        rs.MoveNext
    
    Loop

    If i = 1 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in Jobs")
    If i = 2 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in FRA's")
    If i = 3 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in Reactives")
    If i = 4 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in Maintenance Jobs")
    If i = 5 Then: MsgBox (lngCounter & " of " & rs.RecordCount & " Folderpaths updated in Site Info")
        
End Sub
 
arnelgp said:
there are Many ways to do what you want.
one of those is using Array to hold each SQL:
Code: 
Private Sub m()
    Dim arSQL(1 To 5) As String
    Dim i As Integer
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    arSQL(1) = "select * from table1;"
    arSQL(2) = "select * from table2;"
    arSQL(3) = "select * from table3;"
    arSQL(4) = "select * from table4;"
    arSQL(5) = "select * from table5;"
    Set dbs = CurrentDb
    For i = 1 To 5
        Set rst = dbs.OpenRecordset(arSQL(i), dbOpenDynaset)
        'do same routine for the 5 recordset (1 at a time)
        Call processRst(rst, i)
        rst.Close
        Set rst = Nothing
    Next
End Sub


Private Sub processRst(ByRef rst As DAO.Recordset, i As Integer)
    'your process here
    'Note that i passed the second parameter (i).
    'so if there is special condition for each
    'recordset, you can determine which recordset is passed
    'by this number.
End Sub
Click to expand...

Hi, I have now got all the code working correctly and updating the folder names on the file system as required. The one obvious problem I have come across is if a folder I am trying to rename is open, or if a file or subfolder within that folder is open.

I have a function that will test to see if a specific folder path is open and give a warning but I was wondering if there is anyway of checking the contents of a folder and whether anything within it (files and subfolders) are open prior to renaming and building it into the code I already have? Thanks
 
it would be unwise if you are going to recursively test all time files
on each sub-folders and check if they are open.
it will take you much time.
just Warn the user that No files should be open on the folder of your selection
and proceed with the process.
add an Error Handler in your sub so it can handle errors due to open files.
and exit the sub gracefully.
 
arnelgp said:
it would be unwise if you are going to recursively test all time files
on each sub-folders and check if they are open.
it will take you much time.
just Warn the user that No files should be open on the folder of your selection
and proceed with the process.
add an Error Handler in your sub so it can handle errors due to open files.
and exit the sub gracefully.
Click to expand...
Ok thankyou, I had wondered how hungry it would be on the system. Thanks again for all your help, it is going to be an extremely useful tool!
 
arnelgp said:
yes, it will hungry and hog your system.
but if the number of files are small (no more than 50), go ahead and check each file.
there is an excellent code here.
VBA code to find out if a file is already open - Excel Off The Grid
Click to expand...

Ok that is interesting. I would estimate that each time this process runs there will be around 100 files to check BUT, this process is only very infrequently triggered when a user makes an alteration to a CustomerName which as you will appreciate does not happen vey often. So given it is so infrequent I guess it may be worth me trying it and seeing how system hungry it is.

I have just tried the code you have sent successfully but the trouble is I won't know what the all of the filepaths are. I guess I need a function that uses the single Folderpath I have stored in the DB, then checks that folder and any subfolders and creates a list (recordset) of all of the files it finds, then loops through each of them to check if they are open.

Do you know of a function that would perform this type of operation? Thanks
 
You must log in or register to reply here.

Similar threads

O
Printing/Saving Multiple Reports to PDF
Replies
5
Views
725
sonic8
S
A
Restrictions Update Message
Replies
17
Views
272
Gasman
Gasman
N
Solved Cleaning Up the recordset after use in MS Access
Replies
7
Views
662
gemma-the-husky
gemma-the-husky
N
Data source changed from a table to a query
Replies
13
Views
291
Pat Hartman
P
N
VBA MS Access Error Handling
Replies
5
Views
290
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom