Results 1 to 32 of 32

Thread: Remove special characters from folder file path by VBA

  1. #1

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Lightbulb Remove special characters from folder file path by VBA

    Hi Everyone,

    I have a large amount of folder with sub folders, the folder name contains some special characters (@,#,%,_,-) Like that.
    I have to find the folder by Main folder name,then replace it with alphabets for all sub folders
    for example
    & - AND
    #- NUMBER
    %-PERCENTAGE

    Is that possible to do with VBA on excel, when i select the file path this will replace all the special characters with alphabet (name of the special characters).
    Please anyone help me on this.

    Thanks in advance

  2. #2
    PowerPoster jdc2000's Avatar
    Join Date
    Oct 2001
    Location
    Idaho Falls, Idaho USA
    Posts
    2,393

    Re: Remove special characters from folder file path by VBA

    You can try getting the folder names using Dir and then renaming them after substituting the characters with words to create the new name.

    Possibly useful links:

    https://msdn.microsoft.com/en-us/vba...s/dir-function

    http://www.vbforums.com/showthread.p...ough-excel-vba

  3. #3
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    you can try like

    Code:
    Dim afind, areplace
    afind = Array("@", "#", "%", "_")
    areplace = Array("AT", "NUMBER", "PERCENT", "UNDERSCORE")
    mypath = "c:\temp\aqw\a@dd%ff#"
    newpath = mypath
    For I = 0 To UBound(afind)
        newpath = Replace(newpath, afind(I), areplace(I))
    Next
    Name mypath As newpath
    add any additional characters to be replaced into the arrays
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  4. #4
    New Member Leith Ross's Avatar
    Join Date
    Feb 2018
    Posts
    9

    Re: Remove special characters from folder file path by VBA

    Hello gmmdinesh,

    Here is another way that will let you choose the parent folder and set the depth of the Subfolders to be searched. I have set the macro (CleanFolderPaths) to search all folders and subfolders under the chosen parent.

    Copy and paste this code into a new VBA Module in your workbook.
    Code:
    Global NewPath   As String
    Global oShell    As Object
    Global SpecChars As Variant
    
    Function RenameFolders(ByVal FolderPath As Variant, Optional ByVal SubfolderDepth As Long)
    
        Dim Folder      As Object
        Dim n           As Long
        Dim Subfolder   As Object
        Dim Subfolders  As Object
        
            If oShell Is Nothing Then
                Set oShell = CreateObject("Shell.Application")
            End If
            
            Set Folder = oShell.Namespace(FolderPath)
            
            NewPath = Folder.Self.Path
            
            For n = 1 To UBound(SpecChars, 1)
                NewPath = Replace(NewPath, SpecChars(n, 1), SpecChars(n, 2))
            Next n
    
            Name Folder.Self.Path As NewPath
            
            Set Subfolders = Folder.Items
                Subfolders.Filter 32, "*"
                
                If SubfolderDepth <> 0 Then
                    For Each Subfolder In Subfolders
                        Call RenameFolders(Subfolder, SubfolderDepth - 1)
                    Next Subfolder
                End If
            
    End Function
    
    Sub CleanFolderPaths()
    
        Dim FolderPath As Variant
        
            With Application.FileDialog(msoFileDialogFolderPicker)
                .Filters.Clear
                If .Show Then FolderPath = .SelectedItems(1) Else Exit Sub
            End With
            
            ReDim SpecChars(1 To 4, 1 To 2)
        
            ' Special Characters and replacement strings.
            SpecChars(1, 1) = "&": SpecChars(1, 2) = "And"
            SpecChars(2, 1) = "%": SpecChars(2, 2) = "Percentage"
            SpecChars(3, 1) = "#": SpecChars(3, 2) = "Number"
            SpecChars(4, 1) = "@": SpecChars(4, 2) = "At"
    
            ' -1 = Clean all folders, subfolders, and subfolders of subfolders.
            '  0 = The parent folder only
            '  1 = Subfolders of the parent
            '  2 = Subfolders of the subfolders of the parent.
            '  3 = Subfolders of subfolders of subfolders of the parent, etc.
            Call RenameFolders(FolderPath, -1)
            
    End Sub

  5. #5

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Thank you so much for provide the Links,
    @ westconn, Leith ross, your code is working perfectly, Thank you so much for your Time.
    I have a Workbook with list of parent folder name with A column, I need to select the row and run this macro, it will automatically getting the folder name from A column cell and find the folder from Directory, then replace the all sub folder name on the path.

    Thank again.

  6. #6
    New Member Leith Ross's Avatar
    Join Date
    Feb 2018
    Posts
    9

    Re: Remove special characters from folder file path by VBA

    Hello

    Thanks for the feedback. I have modified the macro to look at "A1" down to the last entry in the column. If the column is empty then the macro simply exits with no message.

    Replace the code you have with this code. Call "CleanFolderPaths" either by using the Macro Dialog (Alt+F8) or add a button to the worksheet to call the macro.

    Code:
    ' Thread:   http://www.vbforums.com/showthread.php?859343-Remove-special-characters-from-folder-file-path-by-VBA
    ' Poster:   gmmdinesh
    
    Public NewPath   As String
    Public oShell    As Object
    Public SpecChars As Variant
    
    Function RenameFolders(ByVal FolderPath As Variant, Optional ByVal SubfolderDepth As Long)
    
        Dim Folder      As Object
        Dim n           As Long
        Dim Subfolder   As Object
        Dim Subfolders  As Object
        
            If oShell Is Nothing Then
                Set oShell = CreateObject("Shell.Application")
            End If
            
            Set Folder = oShell.Namespace(FolderPath)
            
            NewPath = Folder.Self.Path
            
            For n = 1 To UBound(SpecChars, 1)
                NewPath = Replace(NewPath, SpecChars(n, 1), SpecChars(n, 2))
            Next n
    
            Name Folder.Self.Path As NewPath
            
            Set Subfolders = Folder.Items
                Subfolders.Filter 32, "*"
                
                If SubfolderDepth <> 0 Then
                    For Each Subfolder In Subfolders
                        Call RenameFolders(Subfolder, SubfolderDepth - 1)
                    Next Subfolder
                End If
            
    End Function
    
    Sub CleanFolderPaths()
    
        Dim Cell        As Range
        Dim FolderPath  As Variant
        Dim Rng         As Range
        Dim RngBeg      As Range
        Dim RngEnd      As Range
        Dim Wks         As Worksheet
                
            Set Wks = ActiveSheet
            Set RngBeg = Wks.Range("A1")
            Set RngEnd = Wks.Cells(Rows.Count, "A").End(xlUp)
            
            ReDim SpecChars(1 To 4, 1 To 2)
        
            ' Special Characters and replacement strings.
            SpecChars(1, 1) = "&": SpecChars(1, 2) = "And"
            SpecChars(2, 1) = "%": SpecChars(2, 2) = "Percentage"
            SpecChars(3, 1) = "#": SpecChars(3, 2) = "Number"
            SpecChars(4, 1) = "@": SpecChars(4, 2) = "At"
    
            ' -1 = Clean all folders, subfolders, and subfolders of subfolders.
            '  0 = The parent folder only
            '  1 = Subfolders of the parent
            '  2 = Subfolders of the subfolders of the parent.
            '  3 = Subfolders of subfolders of subfolders of the parent, etc.
            
            If RngEnd.Row < RngBeg.Row Then
                Exit Sub
            Else
                Set Rng = Wks.Range(RngBeg, RngEnd)
            End If
            
            For Each Cell In Rng
                Call RenameFolders(Cell.Value, -1)
            Next Cell
    
    End Sub

  7. #7

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Hello Leith Ross
    Sorry for the delay and Thanks for your Code,
    I have checked your code and I got a Debug Error as below.
    Name:  e.jpg
Views: 3251
Size:  42.7 KB

    I have a work book with folder names on A Column and attached the same, and the folder located on E drive. Please look that the attached Workbook.

    Book.zip

    Thanks again.

  8. #8
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    folderpath needs to b the full path of the folder, not just the folder name

    as your workbook only contains the folder name, you need to append the path to the parent folder within the code
    something like

    Code:
    mypath = "c:\temp\"    'change to suit
            For Each Cell In Rng
                Call RenameFolders(mypath & Cell.Value, -1)
            Next Cell
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  9. #9

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    folderpath needs to b the full path of the folder
    Yes these listed folders are placed on E:\Temp\ Path, but i don't know, where i have to put the path in VBA,
    mypath = "c:\temp\" 'change to suit
    For Each Cell In Rng
    Call RenameFolders(mypath & Cell.Value, -1)
    Next Cell
    Where i have to paste this code.?
    Please help me ..

  10. #10
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    Where i have to paste this code.?
    it was just a small edit to the existing code, only one line added and one slightly changed
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  11. #11

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Hi Westconn
    I got a "Type Mismatch" Error on this Line
    For Each Cell In Rng

  12. #12
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    post the entire code, or better post the workbook, zip first
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  13. #13

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    This is the code i have used,
    Code:
    Sub Test()
    Dim afind, areplace
    afind = Array("@", "#", "%", "_")
    areplace = Array("AT", "NUMBER", "PERCENT", "UNDERSCORE")
    mypath = "c:\temp\"    'change to suit
            For Each Cell In Rng
                Call RenameFolders(mypath & Cell.Value, -1)
            Next Cell
    NewPath = mypath
    For I = 0 To UBound(afind)
        NewPath = Replace(NewPath, afind(I), areplace(I))
    Next
    Name mypath As NewPath
    End Sub

  14. #14
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    maybe post #10 was misleading, the small change was to the code in post #6, not the code sample i posted previously

    try like
    Code:
    Sub Test()
    Dim afind, areplace
    afind = Array("@", "#", "%", "_")
    areplace = Array("AT", "NUMBER", "PERCENT", "UNDERSCORE")
    mypath = "c:\temp\"    'change to suit
            For Each Cell In range("a:a")
               if isempty(cell) then exit for   '   finish on first empty cell, or change range to suit
               NewPath = mypath & cell
               For I = 0 To UBound(afind)
                  NewPath = Replace(NewPath, afind(I), areplace(I))
               Next
               Name mypath & cell As NewPath
            Next Cell
    
    End Sub
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  15. #15

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Hi Westconn
    Sorry for the misunderstanding, I have tested both the codes as you posted, but i got error on it.
    Please look the attached file.

    Test.zip

  16. #16
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    as this sample demonstrates that the full path is in the cell

    try like
    Code:
    Sub Test()
    Dim afind, areplace
    afind = Array("@", "#", "%", "_")
    areplace = Array("AT", "NUMBER", "PERCENT", "UNDERSCORE")
    'mypath = "c:\temp\"    'not required
            For Each Cell In range("a:a")
               if isempty(cell) then exit for   '   finish on first empty cell, or change range to suit
               NewPath = cell
               For I = 0 To UBound(afind)
                  NewPath = Replace(NewPath, afind(I), areplace(I))
               Next
               Name cell As NewPath
            Next Cell
    
    End Sub
    this should rename all the folders in column A of the worksheet

    remember once the code has been run the folder name, as in the cell, no longer exists, no error would occur until the name statement
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  17. #17

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Hi Westconn
    I got a "File not found Error" on this line
    Name cell As NewPath
    , even i have a correct folder names and path as mentioned in A column.

  18. #18
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    as i said above,
    if you run the code once, all the folders would be renamed, on any subsequent runs of the code you would get that error as the folders would no longer exist in the file system, even though they would still be in your workbook

    to avoid the error, you could call DIR to ensure that the folder exists, before trying to rename it
    ideally you would possibly remove the folders from the workbook as they are successfully renamed

    if the error is happening for any other reason i can not really see why

    Code:
    Dim afind, areplace
    afind = Array("@", "#", "%", "_")
    areplace = Array("AT", "NUMBER", "PERCENT", "UNDERSCORE")
    'mypath = "e:\temp\"    'change to suit
            For Each Cell In Range("a:a")
               If IsEmpty(Cell) Then Exit For   '   finish on first empty cell, or change range to suit
               If Len(Dir(Cell, vbDirectory)) > 0 Then  ' directory exists in filesystem, else no need
                    NewPath = Cell
                    For I = 0 To UBound(afind)
                       NewPath = Replace(NewPath, afind(I), areplace(I))
                    Next
                    Name Cell As NewPath
               End If
            Next Cell
    while this will prevent any error it may be wasting some time with a list of invalid folders
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  19. #19

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Hey I got same error again..I don't know why the error is coming.
    I did call DIR it shows path exist, but VBA not changed the path.
    Anyway Thanks for your effort, Much Appreciated.

    Thanks again.

  20. #20
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    i did do a test when i posted the original code sample, after creating a folder with a name containing some of the special characters the folder was renamed appropriately, it would appear that the problem is that you path has multiple level or folders to be renamed

    you can only rename one folder at a time, not all the folders in a path, so, for your sample, you would need to rename the last folder and the parent in separate calls, the code posted in post #6 would do that recursively, but that might not be best suited for your requirement, you can try like
    Code:
    Dim afind, areplace
    afind = Array("@", "#", "%", "_")
    areplace = Array("AT", "NUMBER", "PERCENT", "UNDERSCORE")
            For Each cell In Range("a:a")
               If IsEmpty(cell) Then Exit For   '   finish on first empty cell, or change range to suit
               If Len(Dir(cell, vbDirectory)) = 0 Then
                    MsgBox "folder in row " & cell.Row & " is not a valid path"
                    Else
               
                    newpath = cell
                    farray = Split(cell, "\")
                    oldpath = farray(0)
                    
                    For f = 1 To UBound(farray)
                        newpath = oldpath
                        oldpath = oldpath & "\" & farray(f)
                        tmp = farray(f)
                        For I = 0 To UBound(afind)
                           tmp = Replace(tmp, afind(I), areplace(I))
                        Next
                        newpath = newpath & "\" & tmp
                        If Not newpath = oldpath Then Name oldpath As newpath
                    Next
               End If
            Next cell
    i have not tested this as the need to create multiple folders with ugly names just to test seemed a bit excessive
    Last edited by westconn1; Mar 14th, 2018 at 03:25 AM.
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  21. #21

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Yes, You are correct westconn, we can rename only one folder at a time.
    This was worked when i placed the path upto one folder,

    Thank you so much.

  22. #22
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    when i was in bed i realized there were some errors in the code as posted

    if there is more than one subfolder in a folder that needs to be renamed, that folder would be renamed the first time so dir would fail on any calls to that renamed folder

    newpath = oldpath, should in fact have been
    Code:
    oldpath = newpath
    Code:
    Dim afind, areplace
    afind = Array("@", "#", "%", "_")
    areplace = Array("AT", "NUMBER", "PERCENT", "UNDERSCORE")
            For Each cell In Range("a:a")
               If IsEmpty(cell) Then Exit For   '   finish on first empty cell, or change range to suit
                    farray = Split(cell, "\")
                    newpath = farray(0)
                    For f = 1 To UBound(farray)
                        oldpath = newpath
                        oldpath = oldpath & "\" & farray(f)
                        tmp = farray(f)
                        For I = 0 To UBound(afind)
                           tmp = Replace(tmp, afind(I), areplace(I))
                        Next
                        newpath = newpath & "\" & tmp
                        If Len(Dir(oldpath, vbDirectory)) And Not newpath = oldpath Then Name oldpath As newpath
                    Next
                    If Not Len(Dir(newpath, vbDirectory)) Then MsgBox "path in " & cell.Address & " not changed"
            Next cell
    tested with one folder with subfolder only
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  23. #23

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    I got the File/Path Access Error on this
    Then Name oldpath As newpath
    code.

  24. #24
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    If Len(Dir(oldpath, vbDirectory)) And Not newpath = oldpath Then Name oldpath As newpath
    as it checks that oldpath is a valid folder i do not understand why it should fail

    check the values of the 2 variables and post them for comparison
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  25. #25

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Hey Westconn
    Can you please tell me,Which 2 variables i have to check.

  26. #26
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    oldpath and newpath
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  27. #27

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Hello Westconn
    I have tested again the code you posted on post #22. now it's working perfectly.
    I have placed full path in A1 and A2 cell, (A1 Cell Path: E:\temp\123456\a@ujhguy\a@v%bv\@#%
    A2 Cell Path: E:\temp\a@ss\a#k@m_d\@#_%)
    VBA replaced symbols in full path for which i placed in A1 Cell, but A2 Cell path not changed and i got same error File/Path access error again. while trying to change A2 Cell Path.

    Thanks.

  28. #28
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    no idea!!

    i ran some test, i got the same error on the first level folder rename
    i was able to rename the folder to someother name then rename it to newpath, back to oldpath then it would rename from to newpath without error

    the 2nd and 3rd level renames both worked ok first time

    some error handling may be able to fix the problem you have, by doing some of the above steps, but that would be trial and error, and that or similar errors may require different methods on in different circumstances, another possibility that may work would be to try FSO to rename the folder

    the code samples posted do not contain any error handling, including checking to see if newpath already exists, or any invalid characters in the file path, despite the effort i put i to make sure that any folder should be renamed, any other error could occur, like the current one

    one small edit required in the code, change to
    Code:
                    If Not Len(Dir(newpath, vbDirectory)) > 0 Then MsgBox "path in " & cell.Address & " not changed"
    else the message box is likely to show even when the folder is successfully renamed
    Last edited by westconn1; Mar 18th, 2018 at 03:41 PM.
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  29. #29

    Thread Starter
    Lively Member
    Join Date
    Sep 2017
    Posts
    108

    Re: Remove special characters from folder file path by VBA

    Hi Westconn
    Thank you so much for your help.
    Now it's working perfectly.
    I have placed two different path in A1 and A2 cell, code was replaced special character in both the path.

    Thank you so much

  30. #30
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,418

    Re: Remove special characters from folder file path by VBA

    Ah, already solved?
    Damn, i wanted to take a "Hardcore"-Stab at it, consisting of 6 Windows-API-Functions
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

  31. #31
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Remove special characters from folder file path by VBA

    Damn, i wanted to take a "Hardcore"-Stab at it
    go for it i would like to see a better solution
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  32. #32
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,418

    Re: Remove special characters from folder file path by VBA

    Here we go.
    My "Hardcore"-Stab at it


    For those of you interested:
    "201 Folders of & 201 Folders renamed in 3,198 seconds"
    was my result on a 8 year old machine

    EDIT: I'm an Idiot.
    strCSpn is doing exactly what it's supposed to do. There is no strange Behaviour.
    After rereading the Description of the Function it hit me like a Ton of Bricks.
    strCSpn doesn't return the Position of the first occurence of the character(s) i'm looking for.
    It returns the number of characters READ BEFORE the occurence.
    So it's correct, that i have to add +1 to the result to get the position (or change arrReplace to a zero-based array).

    It would probably explain why i'm having so much trouble with a project i'm working on.... *GNARF*

    vb Code:
    1. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    2. Private Declare Function StrCSpn Lib "SHLWAPI" Alias "StrCSpnW" (ByVal lpStr As Long, ByVal lpSet As Long) As Long
    3. Private Declare Function GetTickCount Lib "kernel32" () As Long
    4.  
    5. Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
    6.  
    7. Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    8. Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    9. Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    10.  
    11. '###### Declares for SHFileOperation
    12.  
    13. Const FO_COPY = &H2
    14. Const FO_DELETE = &H3
    15. Const FO_MOVE = &H1
    16. Const FO_RENAME = &H4
    17. Const FOF_ALLOWUNDO = &H40
    18. Const FOF_SILENT = &H4
    19. Const FOF_NOCONFIRMATION = &H10
    20. Const FOF_RENAMEONCOLLISION = &H8
    21. Const FOF_NOCONFIRMMKDIR = &H200
    22. Const FOF_FILESONLY = &H80
    23.  
    24. Private Type SHFILEOPSTRUCT
    25.     hwnd      As Long
    26.     wFunc     As Long
    27.     pFrom     As String
    28.     pTo       As String
    29.     fFlags    As Integer
    30.     fAborted  As Boolean
    31.     hNameMaps As Long
    32.     sProgress As String
    33. End Type
    34.  
    35. '####### Declares for FindFirst, FindNext, FindClose
    36.  
    37. Private Type FILETIME
    38.     dwLowDateTime As Long
    39.     dwHighDateTime As Long
    40. End Type
    41.  
    42. Const MAX_PATH As Long = 259&
    43.  
    44. Private Type WIN32_FIND_DATA
    45.     dwFileAttributes As Long
    46.     ftCreationTime As FILETIME
    47.     ftLastAccessTime As FILETIME
    48.     ftLastWriteTime As FILETIME
    49.     nFileSizeHigh As Long
    50.     nFileSizeLow As Long
    51.     dwReserved0 As Long
    52.     dwReserved1 As Long
    53.     cFileName As String * MAX_PATH
    54.     cAlternate As String * 14
    55. End Type
    56.  
    57. Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
    58. Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800&
    59. Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10&
    60. Const FILE_ATTRIBUTE_HIDDEN As Long = &H2&
    61. Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
    62. Const FILE_ATTRIBUTE_READONLY As Long = &H1&
    63. Const FILE_ATTRIBUTE_SYSTEM As Long = &H4&
    64. Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100&
    65.  
    66. Const PATH_DEL As String = "\"
    67.  
    68. Private SHFileOp As SHFILEOPSTRUCT
    69. Private lngTime As Double
    70. Private EndTime As Double
    71. Private FD As WIN32_FIND_DATA
    72. Private CountFolders As Long
    73. Private CountRenamed As Long
    74. Private IllegalChars As String
    75. Private arrReplace(1 To 10) As String
    76. Private colFolders() As String
    77.  
    78. Sub main()
    79. Dim i As Long
    80. Dim Levels As Long
    81. Dim arrFolders() As String
    82. Dim StartFolder As String
    83.    
    84.     'Setup initial conditions
    85.     'Order of IllegalChars and Array arrReplace must be the same
    86.     IllegalChars = "#-~()[]&$ยง"
    87.  
    88.     arrReplace(1) = "HASH"
    89.     arrReplace(2) = "MINUS"
    90.     arrReplace(3) = "TILDE"
    91.     arrReplace(4) = "POPEN"
    92.     arrReplace(5) = "PCLOSE"
    93.     arrReplace(6) = "BOPEN"
    94.     arrReplace(7) = "BCLOSE"
    95.     arrReplace(8) = "AND"
    96.     arrReplace(9) = "DOLLAR"
    97.     arrReplace(10) = "PARA"
    98.  
    99.     StartFolder = "C:\Temp\TestFolder"
    100.    
    101.     'Setting Attributes
    102.     FD.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY
    103.     SHFileOp.wFunc = FO_RENAME
    104.     SHFileOp.fFlags = FOF_SILENT + FOF_NOCONFIRMATION
    105.    
    106.     'Start Time
    107.     lngTime = GetTickCount
    108.     CountRenamed = 0
    109.    
    110.     Levels = UBound(Split(StartFolder, "\"))
    111.    
    112.     ReDim colFolders(1 To 2, 1 To 1)
    113.    
    114.     CountFolders = CollectFolders(StartFolder)
    115.     i = RenameFolder(colFolders, Levels)
    116.    
    117.     'Ending Timecount
    118.     EndTime = (GetTickCount - lngTime) / 1000
    119.    
    120.     Debug.Print CountRenamed & " Folders of & " & CountFolders & " Folders renamed in " & EndTime & " seconds"
    121.  
    122. End Sub
    123.  
    124. Private Function CollectFolders(ByVal FolderName As String) As Long
    125. Dim i As Long
    126. Dim File As String
    127. Dim hFile As Long
    128. Static CountFound As Long
    129.    
    130.     hFile = FindFirstFile(FolderName & PATH_DEL & "*.", FD)
    131.  
    132.     Do
    133.    
    134.         File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)
    135.            
    136.         If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
    137.    
    138.             If File <> "." And File <> ".." Then
    139.                 'Recursive call to CollectFolders before collecting the PathName
    140.                 'That way it collects it backwards, from the "deepest" Level back
    141.                
    142.                 i = CollectFolders(FolderName & PATH_DEL & File)
    143.                
    144.                 CountFound = CountFound + 1
    145.                 ReDim Preserve colFolders(1 To 2, 1 To CountFound)
    146.                
    147.                 colFolders(1, CountFound) = FolderName & PATH_DEL & File
    148.                 colFolders(2, CountFound) = FolderName & PATH_DEL & File
    149.                
    150.             End If
    151.        
    152.         End If
    153.            
    154.     Loop While FindNextFile(hFile, FD)
    155.    
    156.     FindClose (hFile)
    157.    
    158.     CollectFolders = CountFound
    159.  
    160. End Function
    161.  
    162. Private Function RenameFolder(colFolders As Variant, ByVal Levels As Long) As Long
    163. Dim ch As Integer
    164. Dim i As Long
    165. Dim j As Long
    166. Dim x As Long
    167. Dim NewFile As String
    168. Dim pIllegal As Long
    169. Dim pFile As Long
    170. Dim ErrorCode As Long
    171. Dim arrFolders() As String
    172. Dim CurLevel As Long
    173.    
    174.     For i = 1 To UBound(colFolders, 2)
    175.        
    176.         'Split the complete path in its Elements (==> FolderNames per Level)
    177.         arrFolders = Split(colFolders(1, i), "\")
    178.        
    179.         'We only change the FolderName in the Topmost Level of our Collection-Element
    180.         CurLevel = UBound(arrFolders)
    181.         NewFile = arrFolders(CurLevel)
    182.                
    183.         'Just for checking if we're still inside the correct Level
    184.         'e.g. our Startfolder "c:\Temp\TestFolder" is 2 Levels deep
    185.         If CurLevel - Levels > 0 Then
    186.                    
    187.             Do
    188.                 'Get Pointers to String "IllegalChars" and the FolderName
    189.                 pIllegal = StrPtr(IllegalChars)
    190.                 pFile = StrPtr(NewFile)
    191.                
    192.                 'Scans pFile for the first occurrence of any of the characters that are part of pIllegal,
    193.                 'returning the number of characters of pFile read before this first occurrence.
    194.                 j = StrCSpn(pFile, pIllegal)
    195.    
    196.                 If j < Len(NewFile) Then
    197.                    
    198.                     'Cutting out the illegal Character from the FileName
    199.                     CopyMemory ch, ByVal pFile + 2 * j, 2
    200.                    
    201.                     'Now looking the other way round
    202.                     'Scans the IllegalChars for the first occurence of our illegal character
    203.                     'STRANGE BEHAVIOUR: I have to add 1 to the result! No Idea why
    204.                     j = StrCSpn(pIllegal, StrPtr(Chr(ch))) + 1
    205.                    
    206. If j < Len(IllegalChars) Then
    207.                        
    208.                         'Using the Result of our second StrCSpn-Call (Remember: +1) as the Index of our Replacement-Array
    209.                         NewFile = Replace(NewFile, Chr(ch), arrReplace(j))
    210.                        
    211.                     End If
    212.    
    213.                 End If
    214.    
    215.             Loop Until j > Len(IllegalChars)
    216.             'Assign new Filename back to our temp. array
    217.             arrFolders(CurLevel) = NewFile
    218.            
    219.             'Construct the new Path
    220.             NewFile = Join(arrFolders, "\")
    221.            
    222.             'Back into array
    223.             colFolders(2, i) = NewFile
    224.        
    225.         End If
    226.    
    227.     Next
    228.    
    229.     For i = 1 To UBound(colFolders, 2)
    230.  
    231.         SHFileOp.pFrom = colFolders(1, i)
    232.         SHFileOp.pTo = colFolders(2, i)
    233.  
    234.         ErrorCode = SHFileOperation(SHFileOp)
    235.  
    236.         If Not ErrorCode Then CountRenamed = CountRenamed + 1
    237.    
    238.     Next
    239.                
    240.  
    241. End Function
    Last edited by Zvoni; Mar 29th, 2018 at 02:57 PM.
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width