使用 VBA 更改子文件夹中的文件名 [英] Change File Names within Subfolders with VBA

问题描述

我正在尝试将数百个文件夹上传到 SharePoint，但很遗憾，SharePoint 不允许使用任何特殊字符，例如%".

I am trying to upload a few hundred folders each with files inside of them into SharePoint, but unfortunately SharePoint doesn't allow any special characters like "%".

我正在尝试使用可以自动进入每个子文件夹并替换文件中包含的任何特殊字符(例如%"、#"等)的 VBA 代码.

I'm trying to use a VBA code that can automatically go into each subfolder and replace any special characters contained within the files such as "%", "#", etc.

到目前为止，我所拥有的是:

So far what I have is:

Sub ChangeFileName()

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Folder = objFSO.GetFolder("C:\Users\Documents\TEST\Subfolder")
'Currently the way I have it requires me to change my path a few hundred times
For Each File In Folder.Files
    sNewFile = File.Name
    sNewFile = Replace(sNewFile, "%", "_")
    sNewFile = Replace(sNewFile, "#", "_")
'^and so on`
    If (sNewFile <> File.Name) Then
        File.Move (File.ParentFolder + "\" + sNewFile)
    End If

Next

End Sub

但是对于上面的脚本，您需要特定的子文件夹路径.想知道是否有任何方法可以自动替换子文件夹中文件的特殊字符.如果有帮助，我还可以将所有特定的子文件夹路径粘贴到我的 Excel 工作表的 A 列中.

However for the script above, you need the specific sub-folder path. Wondering if there's any way to automatically replace the special characters of files within subfolders. I can also paste all the specific subfolder paths into column A of my Excel worksheet if that helps.

谢谢！

推荐答案

我用这个代码

Sub GetFileFromFolder()

    Dim fd As FileDialog
    Dim strFolder As String
    Dim colResult As Collection
    Dim i As Long, k As Long
    Dim vSplit
    Dim strFn As String
    Dim vR() As String
    Dim p As String
    Dim iLevel As Integer, cnt As Long



    'iLevel = InputBox(" Subfolder step : ex) 2 ")
        p = Application.PathSeparator
        Set fd = Application.FileDialog(msoFileDialogFolderPicker)
        With fd
            .Show
            .InitialView = msoFileDialogViewList
            .Title = "Select your Root folder"
            .AllowMultiSelect = False

            If .SelectedItems.Count = 0 Then
            Else
                strFolder = .SelectedItems(1)
                Set colResult = SearchFolder(strFolder)

                i = colResult.Count

                For k = 1 To i

                    vSplit = Split(colResult(k), p)
                    strFn = vSplit(UBound(vSplit))
                    strFn = Replace(strFn, "%", "_")
                    strFn = Replace(strFn, "#", "_")

                    'If UBound(vSplit) - UBound(Split(strFolder, p)) = iLevel Then
                        cnt = cnt + 1
                        ReDim Preserve vR(1 To 3, 1 To cnt)
                        On Error Resume Next
                        Err.Clear
                        Name colResult(k) As strFolder & strFn
                        vR(1, cnt) = colResult(k)

                        If Err.Number = 58 Then
                            strFn = Split(strFn, ".")(0) & "_" & vSplit(UBound(vSplit) - 1) & "_" & Date & "." & Split(strFn, ".")(1)
                            Name colResult(k) As strFolder & strFn
                            vR(2, cnt) = strFolder & strFn
                            vR(3, cnt) = "Changed name " 'When filename is duplicated chage filename
                        Else
                            vR(2, cnt) = strFolder & strFn
                        End If
                   ' End If
                Next k

                ActiveSheet.UsedRange.Offset(1).Clear
                Range("a3").Resize(1, 3) = Array("Old file", "New file", "Ect")
                If cnt > 0 Then
                    Range("a4").Resize(cnt, 3) = WorksheetFunction.Transpose(vR)
                End If
                 With ActiveSheet.UsedRange
                    .Borders.LineStyle = xlContinuous
                    .Columns.AutoFit
                    .Font.Size = 9
                End With
            End If
        End With
        MsgBox cnt & " files moved!! "
End Sub
Function SearchFolder(strRoot As String)
    Dim FS As Object

    Dim fsFD As Object
    Dim f As Object
    Dim colFile As Collection
    Dim p As String

    On Error Resume Next
    p = Application.PathSeparator
    If Right(strRoot, 1) = p Then
    Else
        strRoot = strRoot & p
    End If

    Set FS = CreateObject("Scripting.FileSystemObject")
    Set fsFD = FS.GetFolder(strRoot)
    Set colFile = New Collection
    For Each f In fsFD.Files
        colFile.Add f.Path
    Next f

        SearchSubfolder colFile, fsFD


    Set SearchFolder = colFile
    Set fsFD = Nothing
    Set FS = Nothing
    Set colFile = Nothing

End Function
Sub SearchSubfolder(colFile As Collection, objFolder As Object)
    Dim sbFolder As Object
    Dim f As Object
    For Each sbFolder In objFolder.subfolders
        SearchSubfolder colFile, sbFolder
        For Each f In sbFolder.Files
            colFile.Add f.Path
        Next f
    Next sbFolder

End Sub

这篇关于使用 VBA 更改子文件夹中的文件名的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！